home *** CD-ROM | disk | FTP | other *** search
/ Usenet 1993 July / InfoMagic USENET CD-ROM July 1993.ISO / sources / unix / volume2 / basic / part1 < prev    next >
Encoding:
Internet Message Format  |  1986-11-30  |  60.0 KB
  1. From: ukma!david (David Herron, NPR Lover)
  2. Subject: A BASIC interpretor (Part 1 of 4)
  3. Newsgroups: mod.sources
  4. Approved: john@genrad.UUCP
  5.  
  6. Mod.sources:  Volume 2, Issue 23
  7. Submitted by: ukma!david (David Herron, NPR)
  8.  
  9.  
  10. #! /bin/sh
  11. # This is a shell archive, meaning:
  12. # 1. Remove everything above the #! /bin/sh line.
  13. # 2. Save the resulting text in a file.
  14. # 3. Execute the file with /bin/sh (not csh) to create the files:
  15. #    newbs/act.c
  16. #    newbs/action.c
  17. #    newbs/action.c.new
  18. #    newbs/bsint.c
  19. #    newbs/errors.c
  20. #    newbs/mkrbop.c
  21. #    newbs/operat.c.new
  22. # This archive created: Tue Jul 30 13:02:14 1985
  23. export PATH; PATH=/bin:$PATH
  24. if test ! -d 'newbs'
  25. then
  26.     echo shar: creating directory "'newbs'"
  27.     mkdir 'newbs'
  28. fi
  29. echo shar: extracting "'newbs/act.c'" '(14296 characters)'
  30. if test -f 'newbs/act.c'
  31. then
  32.     echo shar: will not over-write existing file "'newbs/act.c'"
  33. else
  34. sed 's/^X//' << \SHAR_EOF > 'newbs/act.c'
  35. /* action.c -- "action" routines for interpretor.  These are the base-level
  36.  *    routines, pointed to by the code-list.
  37.  */
  38.  
  39. #include "bsdefs.h"
  40.  
  41. int status = 0;
  42.  
  43. /* M_COMPILE:
  44.  *    x print x   --to--   x,_print,x
  45.  * M_EXECUTE:
  46.  *    stack: string,x   --to--   x
  47.  *    output: "string\n"
  48.  */
  49. _print(l,p)
  50. int (*l[])(),p;
  51. {
  52.     union value s1;
  53.     switch(status&XMODE) {
  54.     case M_EXECUTE:
  55.         s1 = pop();
  56.         printf("%s",s1.sval);
  57.         if(s1.sval != 0) free(s1.sval);
  58.     case M_FIXUP:
  59.     case M_COMPILE: return(p);
  60.     default:
  61.         STerror("print");
  62.     }
  63. }
  64.  
  65. /* M_COMPILE:
  66.  *    x rlabel name goto x     --to--    x,rlabel,lval,_goto,0,x
  67.  *    (the 0 is for the benefit of interp())
  68.  * M_FIXUP: nothing.
  69.  * any other mode:
  70.  *    stack: lval,x    --to--    x
  71.  *    other: Thisline = lval.lval.codelist;
  72.  *           Thisp = lval.lval.place;
  73.  */
  74. _goto(l,p) int (*l[])(),p;
  75. {
  76.     union value lval;
  77.  
  78.     switch(status&XMODE) {
  79. #ifdef INT
  80.     case M_COMPILE: l[p] = 0;
  81. #endif
  82.     case M_FIXUP: return(++p);
  83.     default:
  84.         lval = pop();
  85.         if(lval.lval.codelist == 0) ULerror(l,p);
  86.         Thisline = lval.lval.codelist;
  87.         Thisline--;
  88.         Thisp = lval.lval.place;
  89. if(dbg) printf("_goto:EXEC:to:llent:%o:pl:%d:num:%u\n",lval.lval.codelist,
  90.     lval.lval.place,lval.lval.codelist->num);
  91.         return(p);
  92.     }
  93. }
  94.  
  95. /* M_COMPILE:
  96.  *    x dlabel name x    --to--    x,_dlabel,&vlist entry,x
  97.  * M_FIXUP:
  98.  *    Make vlist entry for "name" point to current place.
  99.  */
  100. _dlabel(l,p) int (*l[])(),p;
  101. {
  102.     struct dictnode *vp;
  103.     char *s;
  104.  
  105.     switch(status&XMODE) {
  106. #ifdef INT
  107.     case M_COMPILE:
  108.         s=gtok();
  109.         vp=gvadr(s,T_LBL);
  110.         l[p++] = vp;
  111.         return(p);
  112. #endif
  113.     case M_FIXUP:
  114.         vp=l[p++];
  115.         vp->val.lval.codelist = (int **)gllentry(l);
  116.         vp->val.lval.place = p;
  117.         return(p);
  118.     default: return(++p);
  119.     }
  120. }
  121.  
  122. /* M_COMPILE:
  123.  *    x rlabel name x    --to--     x,rlabel,&vlist entry,x
  124.  * any other mode:
  125.  *    push(vp->val)    (i.e.  pointer to location of label)
  126.  */
  127. _rlabel(l,p) int (*l[])(),p;
  128. {
  129.     struct dictnode *vp;
  130.     char *s;
  131.  
  132.     switch(status&XMODE) {
  133. #ifdef INT
  134.     case M_COMPILE:
  135.         s=gtok();
  136.         vp=gvadr(s,T_LBL);
  137.         l[p++] = vp;
  138.         return(p);
  139. #endif
  140.     case M_FIXUP: return(++p);
  141.     default:
  142.         vp = l[p++];
  143. if(dbg) printf("_rlabel:M_EXECUTE:name:%s:llent:%o:place:%d\n",vp->name,
  144.     vp->val.lval.codelist,vp->val.lval.place);
  145.         push(vp->val);
  146.         return(p);
  147.     }
  148. }
  149.  
  150. /* M_COMPILE:
  151.  *    x rlabel name goto x    --to--    x,_rlabel,lval,_gosub,0,x
  152.  *
  153.  * M_EXECUTE:
  154.  *    stack: lval,x   --to--   x
  155.  *    other: saves current place (on stack) and jumps to lval.
  156.  */
  157. _gosub(l,p) int(*l[])(),p;
  158. {
  159.     union value here,there;
  160.     switch(status&XMODE) {
  161. #ifdef INT
  162.     case M_COMPILE:
  163. #endif
  164.     case M_FIXUP:
  165.         l[p++] = 0;
  166.         return(p);
  167.     case M_EXECUTE:
  168.         there = pop();
  169.         here.lval.codelist = gllentry(l);
  170.         here.lval.place = p+1;
  171. if(dbg) printf("_gosub:EXEC:here.l:%o:here.pl:%d:there.l:%o:there.pl:%d\n",
  172.     here.lval.codelist,here.lval.place,there.lval.codelist,there.lval.place);
  173.         push(here);
  174.         Thisline = there.lval.codelist;
  175.         Thisline--;
  176.         Thisp = there.lval.place;
  177.         return(p);
  178.     default: STerror("gosub");
  179.     }
  180. }
  181.  
  182. _return(l,p) int(*l[])(),p;
  183. {
  184.     union value loc;
  185.     switch(status&XMODE) {
  186. #ifdef INT
  187.     case M_COMPILE:
  188. #endif
  189.     case M_FIXUP:
  190.         l[p++] = 0;
  191.         return(p);
  192.     case M_EXECUTE:
  193.         loc = pop();
  194.         Thisp = loc.lval.place;
  195.         Thisline = loc.lval.codelist;
  196.         Thisline--;
  197.         return(p);
  198.     default:
  199.         STerror("return");
  200.     }
  201. }
  202.  
  203. /* Routines control entering and leaving of loops.
  204.  *
  205.  *    enter -- makes a mark that we have entered a loop, and also records
  206.  *         branch points for "continue" and "leave".
  207.  *    exitlp -- undoes the mark made by enter.
  208.  *    contin -- branches to "continue" point.
  209.  *    leave -- branches to "leave" point.
  210.  *
  211.  * The following stack structure is used to record these loop markers.
  212.  */
  213.  
  214. struct loopstack {
  215.     struct label contlb,leavlb;
  216. };
  217.  
  218. struct loopstack lpstk[20];
  219. int lpstkp = -1;    /* -1 when stack is empty.
  220.              * always points to CURRENT loop marker.
  221.              */
  222.  
  223. /* M_COMPILE:
  224.  *    x rlabel contlb rlabel leavlb enter x
  225.  *--to--
  226.  *    x,_rlabel,contlb,_rlabel,_leavlb,_enter,x
  227.  *
  228.  * M_EXECUTE:
  229.  *    loopstack: x    --to--   <contlb,leavlb>,x
  230.  */
  231. _enter(l,p) int (*l[])(),p;
  232. {
  233.     union value loc;
  234.  
  235.     if((status&XMODE) == M_EXECUTE) {
  236.     lpstkp++;
  237.     loc = pop();
  238. if(dbg) printf("_enter:EXEC:lpsp:%d:leav.list:%o:leav.pl:%d",lpstkp,
  239.     loc.lval.codelist,loc.lval.place);
  240.     lpstk[lpstkp].leavlb.codelist = loc.lval.codelist;
  241.     lpstk[lpstkp].leavlb.place = loc.lval.place;
  242.     loc = pop();
  243. if(dbg) printf(":cont.list:%o:cont.pl:%d\n",loc.lval.codelist,loc.lval.place);
  244.     lpstk[lpstkp].contlb.codelist = loc.lval.codelist;
  245.     lpstk[lpstkp].contlb.place = loc.lval.place;
  246.     }
  247.     return(p);
  248. }
  249.  
  250. /* M_EXECUTE:
  251.  *    loopstack: <contlb,leavlb>,x    --to--   x
  252.  *    other: ensures that lpstkp doesnt get less that -1;
  253.  */
  254. _exitlp(l,p) int (*l[])(),p;
  255. {
  256.     if((status&XMODE) == M_EXECUTE)
  257.     if(lpstkp >= 0)
  258.         lpstkp--;
  259.     else
  260.         lpstkp = -1;
  261. if(dbg) printf("_exitlp:M_%d:lpstkp:%d\n",status,lpstkp);
  262.     return(p);
  263. }
  264.  
  265. /* M_COMPILE:
  266.  *    x leave x   --to--   x,_leave,0,x
  267.  *    (the 0 is for the benefit of interp())
  268.  *
  269.  * M_EXECUTE:
  270.  *    loopstack: <contlb,leavlb>,x   --to--   <contlb,leavlb>,x
  271.  *    other: branches to leavlb.  exitlp takes care of cleaning up stack.
  272.  */
  273. _leave(l,p) int(*l[])(),p;
  274. {
  275.     switch(status&XMODE) {
  276. #ifdef INT
  277.     case M_COMPILE:
  278. #endif
  279.     case M_FIXUP: l[p++] = 0; return(p);
  280.     case M_EXECUTE:
  281.         if(lpstkp == -1) /* not inside a loop, ergo cannot leave a loop */
  282.         LVerror(l,p);
  283.         Thisline = lpstk[lpstkp].leavlb.codelist;
  284.         Thisline--;
  285.         Thisp = lpstk[lpstkp].leavlb.place;
  286.         return(p);
  287.     default: STerror("leave");
  288.     }
  289. }
  290.  
  291. /* M_COMPILE:
  292.  *    x contin x    --to--    x,_contin,0,x
  293.  *
  294.  * M_EXECUTE:
  295.  *    loopstack: <contlb,leavlb>,x   --to--   <contlb,leavlb>,x
  296.  *    other: jumps to contlb.
  297.  */
  298. _contin(l,p) int (*l[])(),p;
  299. {
  300.     switch(status&XMODE) {
  301. #ifdef INT
  302.     case M_COMPILE:
  303. #endif
  304.     case M_FIXUP: l[p++] = 0; return(p);
  305.     case M_EXECUTE:
  306.         if(lpstkp == -1) /* cannot continue a loop we're not in */
  307.         CNerror(l,p);
  308.         Thisline = lpstk[lpstkp].contlb.codelist;
  309.         Thisline--;
  310.         Thisp = lpstk[lpstkp].contlb.place;
  311.         return(p);
  312.     default: STerror("contin");
  313.     }
  314. }
  315.  
  316.  
  317.  
  318. /* M_COMPILE:
  319.  *    x rlabel name if x    --to--   x,_rlabel,vp,if,0,x
  320.  *    (the 0 is for the benefit for interp()).
  321.  * M_EXECUTE:
  322.  *    stack: loc,bool,x     --to--   x
  323.  *    p: if bool, p=p else p=loc->place
  324.  */
  325. _if(l,p)
  326. int (*l[])(),p;
  327. {
  328.     union value bv,lv;
  329.  
  330.     switch(status&XMODE) {
  331.     case M_EXECUTE:
  332.         lv = pop();
  333.         bv = pop();
  334. if(dbg) printf("_if:M_EXECUTE:lv.pl:%d:p:%d:bv.iv:%D\n",lv.lval.place,
  335.     p,bv.ival);
  336.         if(bv.ival == (long)0) { /* jump to else part. */
  337.         Thisline = lv.lval.codelist;
  338.         Thisline--;
  339.         Thisp = lv.lval.place;
  340.         }
  341.         else p++;    /* skip the 0 so we get to the then part */
  342.         return(p);
  343.     case M_FIXUP:
  344.     case M_COMPILE: l[p++] = 0; return(p);
  345.     default: STerror("if");
  346.     }
  347. }
  348.  
  349. /* M_COMPILE:
  350.  *    var name <from>expr <to>expr <step>expr <flag>con 0 dlabel FORx rlabel FORx+1 for
  351.  *--to--
  352.  *    _var,vp,<from>,<to>,<step>,<flag>,0,_dlabel,lblp,_rlabel,lblp2,_for
  353.  *
  354.  * M_EXECUTE:
  355.  *    stack: xitpt,vizd,step,to,from,vp,x
  356.  *    other: if exit conditions are correct, jump to exit point.
  357.  *        vizd is used to hold the data type for vp.  Data types
  358.  *        are always non-zero so the test for the first visit to
  359.  *        the loop is to see if vizd is 0.
  360.  */
  361. _for(l,p) int(*l[])(),p;
  362. {
  363.     union value xitpt,vizd,from,to,step,place;
  364.  
  365.     switch(status&XMODE) {
  366. #ifdef INT
  367.     case M_COMPILE:
  368. #endif
  369.     case M_FIXUP: l[p++] = 0; return(p);
  370.     case M_EXECUTE:
  371.         xitpt = pop();    vizd = pop();
  372.         step = pop();    to = pop();
  373.         from = pop();
  374. if(dbg) printf("_for:EXEC:xit.l:%o:xit.pl:%d:viz.iv:%D:step.iv:%D:to.iv:%D:from.iv:%D:",
  375.     xitpt.lval.codelist,xitpt.lval.place,(long)vizd.ival,(long)step.ival,(long)to.ival,(long)from.ival);
  376.         if(vizd.ival == 0) { /* first visit to loop */
  377.         place = pop();
  378. if(dbg) printf("first time:var:%s:",place.vpval->name);
  379.         vizd.ival = place.vpval->type_of_value&T_TMASK; /* != 0 */
  380.         place.plval = getplace(place.vpval);
  381.         *(place.plval) = from;    /* since first time, set starting val */
  382. if(dbg) printf("var.pl:%o:var.val:%D:",place.plval,(long)place.plval->ival);
  383.         if(vizd.ival==T_INT && step.ival==0)
  384.             if(to.ival < from.ival)
  385.                 step.ival = -1;
  386.             else
  387.                 step.ival = 1;
  388.         else if(vizd.ival==T_DBL && step.rval==0)
  389.             if(to.rval < from.rval)
  390.                 step.rval = -1;
  391.             else
  392.                 step.rval = 1;
  393.         }
  394.         else place = pop();
  395. if(dbg) printf("var.place:%o:",place.plval);
  396.  
  397.         /* The stack frame is now correctly popped off.
  398.          * Next, we check if the loop is finished.
  399.          */
  400.  
  401.         if(vizd.ival == T_INT)
  402.         if(step.ival<0 && place.plval->ival<to.ival) goto loop_done;
  403.         else if(step.ival>0 && place.plval->ival>to.ival) goto loop_done;
  404.         else /* vizd.ival == T_DBL */
  405.         if(step.rval<0 && place.plval->rval<to.rval) goto loop_done;
  406.         else if(step.rval>0 && place.plval->rval>to.rval) goto loop_done;
  407.  
  408.         /* Loop is not done yet, push back stack frame. */
  409.  
  410. if(dbg) printf("loop not done, push everything back\n");
  411.         push(place);    push(from);    push(to);
  412.         push(step);        push(vizd);    push(xitpt);
  413.         return(p);
  414.  
  415.     /* Come here when the loop is finished. */
  416. loop_done:
  417. if(dbg) printf("loop done, jump to xitpt\n");
  418.         Thisline = xitpt.lval.codelist;
  419.         Thisline--;
  420.         Thisp = xitpt.lval.place;
  421.         return(p);
  422.     default: STerror("for");
  423.     }
  424. }
  425.  
  426. /* M_COMPILE:
  427.  *    var name next rlabel FORx go@ dlabel FORx+1
  428.  *--to--
  429.  *    _var,vp,_next,_rlabel,lblp,_go_at,dlabel,lblp2
  430.  *
  431.  * M_EXECUTE:
  432.  *    stack: same as M_EXECUTE in _for.
  433.  *    other: adds step to (control var)->val.
  434.  */
  435. _next(l,p) int(*l[])(),p;
  436. {
  437.     union value vp,xitpt,vizd,step,to,from,place;
  438.  
  439.     switch(status&XMODE) {
  440.     case M_COMPILE:
  441.     case M_FIXUP: return(p);
  442.     case M_EXECUTE:
  443.         vp = pop();
  444. if(dbg) printf("_next():EXEC:var:%s",vp.vpval->name);
  445.         vp.plval = getplace(vp.vpval);
  446. if(dbg) printf(":vp.pl:%o:",vp.plval);
  447.         xitpt = pop();    vizd = pop();    step = pop();
  448.         to = pop();        from = pop();    place = pop();
  449. if(dbg) printf("pl.pl:%o:from.iv:%D:to.iv:%D:step.iv:%D:viz.iv:%D:",
  450.     place.plval,(long)from.ival,(long)to.ival,(long)step.ival,(long)vizd.ival);
  451. if(dbg) printf("xit.list:%o:xit.pl:%d:xit.num:%u\n",xitpt.lval.codelist,
  452.     xitpt.lval.place,xitpt.lval.codelist->num);
  453.         if(place.plval != vp.plval) FNerror(l,p);
  454.         if(vizd.ival == T_INT)
  455.         place.plval->ival += step.ival;
  456.         else
  457.         place.plval->rval += step.rval;
  458.         push(place);    push(from);    push(to);    
  459.         push(step);        push(vizd);    push(xitpt);
  460.         return(p);
  461.     default: STerror("next");
  462.     }
  463. }
  464.  
  465. /* variables needed for M_READ. */
  466.  
  467. struct line *dlist[DLSIZ];
  468. int dlp = 0;
  469. int dlindx = 2;        /* skips <_data,0> */
  470. int dtype;        /* type of last operation. */
  471.  
  472.  
  473. /* M_COMPILE:
  474.  *    x data x     --to--    x,_data,0,x     (0 is for interp())
  475.  * M_FIXUP:
  476.  *    allocates a spot in dlist, stores pointer to llist entry for
  477.  *    this line at that spot.
  478.  * M_EXECUTE:
  479.  *    Returns, with p pointing at the zero, making interp() return.
  480.  */
  481. _data(l,p) int(*l[])(),p;
  482. {
  483.     switch(status&XMODE) {
  484. #ifdef INT
  485.     case M_COMPILE:
  486.         l[p++] = 0;
  487.         return(p);
  488. #endif
  489.     case M_FIXUP:
  490.         dlist[dlp++] = gllentry(l);
  491.         p++;
  492.     case M_EXECUTE: return(p);
  493.     default:
  494.         STerror("data");
  495.     }
  496. }
  497.  
  498. /* M_COMPILE:  x dsep x   --to--   x,_dsep,0,x
  499.  */
  500. _dsep(l,p) int(*l[])(),p;
  501. {
  502.     switch(status&XMODE) {
  503. #ifdef INT
  504.     case M_COMPILE:
  505. #endif
  506.     case M_FIXUP:
  507.         l[p++] = 0;
  508.     case M_READ:
  509.     case M_EXECUTE: return(p);
  510.     default: STerror("dsep");
  511.     }
  512. }
  513.  
  514. /* routines for changing the interpretors state. */
  515.  
  516. struct statstk {    /* for saving old states */
  517.     int stkp;
  518.     int stat;
  519. } sstk[30];
  520. int sstktop = 0;
  521.  
  522. /* M_COMPILE:
  523.  *    x pushstate <state> x    --to--    x,pushstate,<state>,x
  524.  * M_FIXUP:
  525.  *    skip <state>
  526.  * any other state:
  527.  *    save old state and stack pointer.
  528.  *    set state to <state>.
  529.  */
  530. _pushstate(l,p) int (*l[])(),p;
  531. {
  532.     switch(status&XMODE) {
  533. #ifdef INT
  534.     case M_COMPILE:
  535.         l[p++] = atoi(int_in());
  536.         return(p);
  537. #endif
  538.     case M_FIXUP: return(++p);
  539.     default:
  540.         sstk[sstktop].stkp = stackp;
  541.         sstk[sstktop].stat = status;
  542.         sstktop++;
  543.         status = l[p++];
  544.         return(p);
  545.     }
  546. }
  547. _popstate(l,p) int (*l[])(),p;
  548. {
  549.     switch(status&XMODE) {
  550. #ifdef INT
  551.     case M_COMPILE:
  552. #endif
  553.     case M_FIXUP: return(p);
  554.     default:
  555.         sstktop--;
  556.         stackp = sstk[sstktop].stkp;
  557.         status = sstk[sstktop].stat&XMODE;
  558.         return(p);
  559.     }
  560. }
  561.  
  562.  
  563. /* stack maintanence routines.
  564.  */
  565.  
  566.  
  567. /* M_COMPILE:
  568.  *    x spop x    --to--    x,_spop,x
  569.  * M_EXECUTE:
  570.  *    stack: string,x   --to--   x
  571.  *    other: frees storage used by string (if any).
  572.  */
  573. _spop(l,p) int(*l[])(),p;
  574. {
  575.     union value s;
  576.  
  577.     switch(status&XMODE) {
  578.     case M_EXECUTE:
  579.         s=pop();
  580.         if(s.sval != 0) free(s.sval);
  581. #ifdef INT
  582.     case M_COMPILE:
  583. #endif
  584.     case M_FIXUP: return(p);
  585.     default:
  586.         STerror("spop");
  587.     }
  588. }
  589.  
  590. /* M_COMPILE:
  591.  *    x pop x    --to--    x,_pop,x
  592.  * M_EXECUTE:
  593.  *    stack: int,x    --to--   x
  594.  */
  595. _pop(l,p) int(*l[])(),p;
  596. {
  597.     switch(status&XMODE) {
  598.     case M_FIXUP:
  599.     case M_COMPILE: return(p);
  600.     case M_EXECUTE: pop(); return(p);
  601.     default:
  602.         STerror("pop");
  603.     }
  604. }
  605.  
  606. _stop(l,p) int(*l[])(),p;
  607. {
  608.     switch(status&XMODE) {
  609.     case M_FIXUP:
  610.     case M_COMPILE: return(p);
  611.     case M_EXECUTE: exit(1);
  612.     default:
  613.         STerror("stop");
  614.     }
  615. }
  616. _end(l,p) int (*l[])(),p; { return(_stop(l,p)); }
  617.  
  618.  
  619. /* operator list for the intermediate language. */
  620. struct wlnode wlist[] = {
  621.     "itoa",_itoa,    "print",_print,    "goto",_goto,    "if",_if,  "rtoa",_rtoa,
  622.     "itor",_itor,    "rtoi",_rtoi,    "gosub",_gosub,  "return",_return,
  623.     "scon",_scon,    "icon",_icon,    "i+",_iadd,    "-",_isub,
  624.     "rcon",_rcon,    "r+",_radd,    "r-",_rsub,
  625.     "i*",_imult,    "i/",_idiv,    "i%",_imod,    ",",_comma,
  626.     "r*",_rmult,    "r/",_rdiv,    ";",_scolon,
  627.     "i==",_ieq,    "s==",_seq,    "r==",_req,
  628.     "i<>",_ineq,    "r<>",_rneq,    "s<>",_sneq,
  629.     "i<=",_ileq,    "s<=",_sleq,    "r<=",_rleq,
  630.     "i<",_ilt,    "s<",_slt,    "r<",_rlt,
  631.     "i>=",_igeq,    "s>=",_sgeq,    "r>=",_rgeq,
  632.     "i>",_igt,    "s>",_sgt,    "r>",_rgt,
  633.     "or",_or,    "and",_and,    "val",_val,    "not",_not,
  634.     "pop",_pop,    "spop",_spop,
  635.     "stop",_stop,    "end",_end,    "var",_var,    "store",_store,
  636.     "for",_for,    "next",_next,
  637.     "dlabel",_dlabel,    "rlabel",_rlabel,
  638.     "contin",_contin,  "leave",_leave,  "enter",_enter,  "exitlp",_exitlp,
  639.     "data",_data,    "dsep",_dsep,
  640.     "pushstate",_pushstate,        "popstate",_popstate,
  641.     0,0
  642. };
  643.  
  644. SHAR_EOF
  645. if test 14296 -ne "`wc -c < 'newbs/act.c'`"
  646. then
  647.     echo shar: error transmitting "'newbs/act.c'" '(should have been 14296 characters)'
  648. fi
  649. fi # end of overwriting check
  650. echo shar: extracting "'newbs/action.c'" '(12253 characters)'
  651. if test -f 'newbs/action.c'
  652. then
  653.     echo shar: will not over-write existing file "'newbs/action.c'"
  654. else
  655. sed 's/^X//' << \SHAR_EOF > 'newbs/action.c'
  656. /* action.c -- "action" routines for interpretor.  These are the base-level
  657.  *    routines, pointed to by the code-list.
  658.  */
  659.  
  660. #include "bsdefs.h"
  661.  
  662. int status = 0;
  663.  
  664. /* M_COMPILE:
  665.  *    x print x   --to--   x,_print,x
  666.  * M_EXECUTE:
  667.  *    stack: string,x   --to--   x
  668.  *    output: "string\n"
  669.  */
  670. _print(l,p)
  671. int (*l[])(),p;
  672. {
  673.     union value s1;
  674.     if((status&XMODE) == M_EXECUTE) {
  675.         s1 = pop();
  676.         printf("%s",s1.sval);
  677.         if(s1.sval != 0) free(s1.sval);
  678.     }
  679.     return(p);
  680. }
  681.  
  682. /* M_COMPILE:
  683.  *    x rlabel name goto x     --to--    x,rlabel,lval,_goto,0,x
  684.  *    (the 0 is for the benefit of interp())
  685.  * M_FIXUP: nothing.
  686.  * any other mode:
  687.  *    stack: lval,x    --to--    x
  688.  *    other: Thisline = lval.lval.codelist;
  689.  *           Thisp = lval.lval.place;
  690.  */
  691. _goto(l,p) int (*l[])(),p;
  692. {
  693.     union value lval;
  694.  
  695.     if((status&XMODE) == M_FIXUP) return(++p);
  696.     if((status&XMODE) == M_EXECUTE) {
  697.         lval = pop();
  698.         if(lval.lval.codelist == 0) ULerror(l,p);
  699.         Thisline = lval.lval.codelist;
  700.         Thisline--;
  701.         Thisp = lval.lval.place;
  702. if(dbg) printf("_goto:EXEC:to:llent:%o:pl:%d:num:%u\n",lval.lval.codelist,
  703.     lval.lval.place,lval.lval.codelist->num);
  704.         return(p);
  705.     }
  706.     return(p);
  707. }
  708.  
  709. /* M_COMPILE:
  710.  *    x dlabel name x    --to--    x,_dlabel,&vlist entry,x
  711.  * M_FIXUP:
  712.  *    Make vlist entry for "name" point to current place.
  713.  */
  714. _dlabel(l,p) int (*l[])(),p;
  715. {
  716.     struct dictnode *vp;
  717.  
  718.     if((status&XMODE) == M_FIXUP) {
  719.         vp=l[p++];
  720.         vp->val.lval.codelist = (int **)gllentry(l);
  721.         vp->val.lval.place = p;
  722.         return(p);
  723.     }
  724.     p++; return(p);    /* skip over the vp in any other mode */
  725. }
  726.  
  727. /* M_COMPILE:
  728.  *    x rlabel name x    --to--     x,rlabel,&vlist entry,x
  729.  * any other mode:
  730.  *    push(vp->val)    (i.e.  pointer to location of label)
  731.  */
  732. _rlabel(l,p) int (*l[])(),p;
  733. {
  734.     struct dictnode *vp;
  735.  
  736.     if((status&XMODE) == M_FIXUP) return(++p);
  737.     if((status&XMODE) == M_EXECUTE) {
  738.         vp = l[p++];
  739. if(dbg) printf("_rlabel:M_EXECUTE:name:%s:llent:%o:place:%d\n",vp->name,
  740.     vp->val.lval.codelist,vp->val.lval.place);
  741.         push(vp->val);
  742.     }
  743.         return(p);
  744. }
  745.  
  746. /* M_COMPILE:
  747.  *    x rlabel name gosub x    --to--    x,_rlabel,lval,_gosub,0,x
  748.  *
  749.  * M_EXECUTE:
  750.  *    stack: lval,x   --to--   x
  751.  *    other: saves current place (on stack) and jumps to lval.
  752.  */
  753. _gosub(l,p) int(*l[])(),p;
  754. {
  755.     union value here,there;
  756.     if((status&XMODE) == M_FIXUP) return(++p);
  757.     if((status&XMODE) == M_EXECUTE) {
  758.         there = pop();
  759.         here.lval.codelist = gllentry(l);
  760.         here.lval.place = p+1;
  761. if(dbg) printf("_gosub:EXEC:here.l:%o:here.pl:%d:there.l:%o:there.pl:%d\n",
  762.     here.lval.codelist,here.lval.place,there.lval.codelist,there.lval.place);
  763.         push(here);
  764.         Thisline = there.lval.codelist;
  765.         Thisline--;
  766.         Thisp = there.lval.place;
  767.     }
  768.         return(p);
  769. }
  770.  
  771. _return(l,p) int(*l[])(),p;
  772. {
  773.     union value loc;
  774.     if((status&XMODE) == M_FIXUP) return(++p);
  775.     if((status&XMODE) == M_EXECUTE) {
  776.         loc = pop();
  777.         Thisp = loc.lval.place;
  778.         Thisline = loc.lval.codelist;
  779.         Thisline--;
  780.     }
  781.         return(p);
  782. }
  783.  
  784. /* Routines control entering and leaving of loops.
  785.  *
  786.  *    enter -- makes a mark that we have entered a loop, and also records
  787.  *         branch points for "continue" and "leave".
  788.  *    exitlp -- undoes the mark made by enter.
  789.  *    contin -- branches to "continue" point.
  790.  *    leave -- branches to "leave" point.
  791.  *
  792.  * The following stack structure is used to record these loop markers.
  793.  */
  794.  
  795. struct loopstack {
  796.     struct label contlb,leavlb;
  797. };
  798.  
  799. struct loopstack lpstk[20];
  800. int lpstkp = -1;    /* -1 when stack is empty.
  801.              * always points to CURRENT loop marker.
  802.              */
  803.  
  804. /* M_COMPILE:
  805.  *    x rlabel contlb rlabel leavlb enter x
  806.  *--to--
  807.  *    x,_rlabel,contlb,_rlabel,_leavlb,_enter,x
  808.  *
  809.  * M_EXECUTE:
  810.  *    loopstack: x    --to--   <contlb,leavlb>,x
  811.  */
  812. _enter(l,p) int (*l[])(),p;
  813. {
  814.     union value loc;
  815.  
  816.     if((status&XMODE) == M_EXECUTE) {
  817.     lpstkp++;
  818.     loc = pop();
  819. if(dbg) printf("_enter:EXEC:lpsp:%d:leav.list:%o:leav.pl:%d",lpstkp,
  820.     loc.lval.codelist,loc.lval.place);
  821.     lpstk[lpstkp].leavlb.codelist = loc.lval.codelist;
  822.     lpstk[lpstkp].leavlb.place = loc.lval.place;
  823.     loc = pop();
  824. if(dbg) printf(":cont.list:%o:cont.pl:%d\n",loc.lval.codelist,loc.lval.place);
  825.     lpstk[lpstkp].contlb.codelist = loc.lval.codelist;
  826.     lpstk[lpstkp].contlb.place = loc.lval.place;
  827.     }
  828.     return(p);
  829. }
  830.  
  831. /* M_EXECUTE:
  832.  *    loopstack: <contlb,leavlb>,x    --to--   x
  833.  *    other: ensures that lpstkp doesnt get less that -1;
  834.  */
  835. _exitlp(l,p) int (*l[])(),p;
  836. {
  837.     if((status&XMODE) == M_EXECUTE)
  838.     if(lpstkp >= 0)
  839.         lpstkp--;
  840.     else
  841.         lpstkp = -1;
  842. if(dbg) printf("_exitlp:M_%d:lpstkp:%d\n",status,lpstkp);
  843.     return(p);
  844. }
  845.  
  846. /* M_COMPILE:
  847.  *    x leave x   --to--   x,_leave,0,x
  848.  *    (the 0 is for the benefit of interp())
  849.  *
  850.  * M_EXECUTE:
  851.  *    loopstack: <contlb,leavlb>,x   --to--   <contlb,leavlb>,x
  852.  *    other: branches to leavlb.  exitlp takes care of cleaning up stack.
  853.  */
  854. _leave(l,p) int(*l[])(),p;
  855. {
  856.     if((status&XMODE) == M_FIXUP) return(++p);
  857.     if((status&XMODE) == M_EXECUTE) {
  858.         if(lpstkp == -1) /* not inside a loop, ergo cannot leave a loop */
  859.         LVerror(l,p);
  860.         Thisline = lpstk[lpstkp].leavlb.codelist;
  861.         Thisline--;
  862.         Thisp = lpstk[lpstkp].leavlb.place;
  863.     }
  864.         return(p);
  865. }
  866.  
  867. /* M_COMPILE:
  868.  *    x contin x    --to--    x,_contin,0,x
  869.  *
  870.  * M_EXECUTE:
  871.  *    loopstack: <contlb,leavlb>,x   --to--   <contlb,leavlb>,x
  872.  *    other: jumps to contlb.
  873.  */
  874. _contin(l,p) int (*l[])(),p;
  875. {
  876.     if((status&XMODE) == M_FIXUP) return(++p);
  877.     if((status&XMODE) == M_EXECUTE) {
  878.         if(lpstkp == -1) /* cannot continue a loop we're not in */
  879.         CNerror(l,p);
  880.         Thisline = lpstk[lpstkp].contlb.codelist;
  881.         Thisline--;
  882.         Thisp = lpstk[lpstkp].contlb.place;
  883.     }
  884.         return(p);
  885. }
  886.  
  887.  
  888.  
  889. /* M_COMPILE:
  890.  *    x rlabel name if x    --to--   x,_rlabel,vp,if,0,x
  891.  *    (the 0 is for the benefit for interp()).
  892.  * M_EXECUTE:
  893.  *    stack: loc,bool,x     --to--   x
  894.  *    p: if bool, p=p else p=loc->place
  895.  */
  896. _if(l,p)
  897. int (*l[])(),p;
  898. {
  899.     union value bv,lv;
  900.  
  901.     if((status&XMODE) == M_FIXUP) return(++p);
  902.     if((status&XMODE) == M_EXECUTE) {
  903.         lv = pop();
  904.         bv = pop();
  905. if(dbg) printf("_if:M_EXECUTE:lv.pl:%d:p:%d:bv.iv:%D\n",lv.lval.place,
  906.     p,bv.ival);
  907.         if(bv.ival == (long)0) { /* jump to else part. */
  908.         Thisline = lv.lval.codelist;
  909.         Thisline--;
  910.         Thisp = lv.lval.place;
  911.         }
  912.         else p++;    /* skip the 0 so we get to the then part */
  913.     }
  914.         return(p);
  915. }
  916.  
  917. /* M_COMPILE:
  918.  *    var name <from>expr <to>expr <step>expr <flag>con 0 dlabel FORx rlabel FORx+1 for
  919.  *--to--
  920.  *    _var,vp,<from>,<to>,<step>,<flag>,0,_dlabel,lblp,_rlabel,lblp2,_for
  921.  *
  922.  * M_EXECUTE:
  923.  *    stack: xitpt,vizd,step,to,from,vp,x
  924.  *    other: if exit conditions are correct, jump to exit point.
  925.  *        vizd is used to hold the data type for vp.  Data types
  926.  *        are always non-zero so the test for the first visit to
  927.  *        the loop is to see if vizd is 0.
  928.  */
  929. _for(l,p) int(*l[])(),p;
  930. {
  931.     union value xitpt,vizd,from,to,step,place;
  932.  
  933.     if((status&XMODE) == M_FIXUP) return(++p);
  934.     if((status&XMODE) == M_EXECUTE) {
  935.         xitpt = pop();    vizd = pop();
  936.         step = pop();    to = pop();
  937.         from = pop();
  938. if(dbg) printf("_for:EXEC:xit.l:%o:xit.pl:%d:viz.iv:%D:step.iv:%D:to.iv:%D:from.iv:%D:",
  939.     xitpt.lval.codelist,xitpt.lval.place,(long)vizd.ival,(long)step.ival,(long)to.ival,(long)from.ival);
  940.         if(vizd.ival == 0) { /* first visit to loop */
  941.         place = pop();
  942. if(dbg) printf("first time:var:%s:",place.vpval->name);
  943.         vizd.ival = place.vpval->type_of_value&T_TMASK; /* != 0 */
  944.         place.plval = getplace(place.vpval);
  945.         *(place.plval) = from;    /* since first time, set starting val */
  946.         if(vizd.ival == T_INT) { /* if it is an INT, convert to/from/step to INT also */
  947.             to.ival = (long)to.rval;
  948.             from.ival = (long)from.rval;
  949.             step.ival = (long)step.rval;
  950.         }
  951. if(dbg) printf("var.pl:%o:var.val:%D:",place.plval,(long)place.plval->ival);
  952.         if(vizd.ival==T_INT && step.ival==0)
  953.             if(to.ival < from.ival)
  954.                 step.ival = -1;
  955.             else
  956.                 step.ival = 1;
  957.         else if(vizd.ival==T_DBL && step.rval==0)
  958.             if(to.rval < from.rval)
  959.                 step.rval = -1;
  960.             else
  961.                 step.rval = 1;
  962.         }
  963.         else place = pop();
  964. if(dbg) printf("var.place:%o:",place.plval);
  965.  
  966.         /* The stack frame is now correctly popped off.
  967.          * Next, we check if the loop is finished.
  968.          */
  969.  
  970.         if(vizd.ival == T_INT)
  971.         if(step.ival<0 && place.plval->ival<to.ival) goto loop_done;
  972.         else if(step.ival>0 && place.plval->ival>to.ival) goto loop_done;
  973.         else /* vizd.ival == T_DBL */
  974.         if(step.rval<0 && place.plval->rval<to.rval) goto loop_done;
  975.         else if(step.rval>0 && place.plval->rval>to.rval) goto loop_done;
  976.  
  977.         /* Loop is not done yet, push back stack frame. */
  978.  
  979. if(dbg) printf("loop not done, push everything back\n");
  980.         push(place);    push(from);    push(to);
  981.         push(step);        push(vizd);    push(xitpt);
  982.         return(++p);    /* skip over the 0 */
  983.  
  984.     /* Come here when the loop is finished. */
  985. loop_done:
  986. if(dbg) printf("loop done, jump to xitpt\n");
  987.         Thisline = xitpt.lval.codelist;
  988.         Thisline--;
  989.         Thisp = xitpt.lval.place;
  990.         return(p);    /* hit the 0 */
  991.     }
  992. return(p);
  993. }
  994.  
  995. /* M_COMPILE:
  996.  *    var name next rlabel FORx goto dlabel FORx+1
  997.  *--to--
  998.  *    _var,vp,_next,_rlabel,lblp,_goto,dlabel,lblp2
  999.  *
  1000.  * M_EXECUTE:
  1001.  *    stack: same as M_EXECUTE in _for.
  1002.  *    other: adds step to (control var)->val.
  1003.  */
  1004. _next(l,p) int(*l[])(),p;
  1005. {
  1006.     union value vp,xitpt,vizd,step,to,from,place;
  1007.  
  1008.     if((status&XMODE) == M_EXECUTE) {
  1009.         vp = pop();
  1010. if(dbg) printf("_next():EXEC:var:%s",vp.vpval->name);
  1011.         vp.plval = getplace(vp.vpval);
  1012. if(dbg) printf(":vp.pl:%o:",vp.plval);
  1013.         xitpt = pop();    vizd = pop();    step = pop();
  1014.         to = pop();        from = pop();    place = pop();
  1015. if(dbg) printf("pl.pl:%o:from.iv:%D:to.iv:%D:step.iv:%D:viz.iv:%D:",
  1016.     place.plval,(long)from.ival,(long)to.ival,(long)step.ival,(long)vizd.ival);
  1017. if(dbg) printf("xit.list:%o:xit.pl:%d:xit.num:%u\n",xitpt.lval.codelist,
  1018.     xitpt.lval.place,xitpt.lval.codelist->num);
  1019.         if(place.plval != vp.plval) FNerror(l,p);
  1020.         if(vizd.ival == T_INT)
  1021.         place.plval->ival += step.ival;
  1022.         else
  1023.         place.plval->rval += step.rval;
  1024.         push(place);    push(from);    push(to);    
  1025.         push(step);        push(vizd);    push(xitpt);
  1026.         return(p);
  1027.     }
  1028. return(p);
  1029. }
  1030.  
  1031. /* variables needed for M_READ. */
  1032.  
  1033. struct line *dlist[DLSIZ];
  1034. int dlp = 0;
  1035. int dlindx = 2;        /* skips <_data,0> */
  1036. int dtype;        /* type of last operation. */
  1037.  
  1038.  
  1039. /* M_COMPILE:
  1040.  *    x data x     --to--    x,_data,0,x     (0 is for interp())
  1041.  * M_FIXUP:
  1042.  *    allocates a spot in dlist, stores pointer to llist entry for
  1043.  *    this line at that spot.
  1044.  * M_EXECUTE:
  1045.  *    Returns, with p pointing at the zero, making interp() return.
  1046.  */
  1047. _data(l,p) int(*l[])(),p;
  1048. {
  1049.     if((status&XMODE) == M_FIXUP) {
  1050.         dlist[dlp++] = gllentry(l);
  1051.         p++;
  1052.     }
  1053.     return(p);
  1054. }
  1055.  
  1056. /* M_COMPILE:  x dsep x   --to--   x,_dsep,0,x
  1057.  */
  1058. _dsep(l,p) int(*l[])(),p;
  1059. {
  1060.     if((status&XMODE) == M_FIXUP) ++p;
  1061.     return(p);
  1062. }
  1063.  
  1064. /* routines for changing the interpretors state. */
  1065.  
  1066. struct statstk {    /* for saving old states */
  1067.     int stkp;
  1068.     int stat;
  1069. } sstk[30];
  1070. int sstktop = 0;
  1071.  
  1072. /* M_COMPILE:
  1073.  *    x pushstate <state> x    --to--    x,pushstate,<state>,x
  1074.  * M_FIXUP:
  1075.  *    skip <state>
  1076.  * any other state:
  1077.  *    save old state and stack pointer.
  1078.  *    set state to <state>.
  1079.  */
  1080. _pushstate(l,p) int (*l[])(),p;
  1081. {
  1082.     if((status&XMODE) == M_FIXUP) return(++p);
  1083.         sstk[sstktop].stkp = stackp;
  1084.         sstk[sstktop].stat = status;
  1085.         sstktop++;
  1086.         status = l[p++];
  1087.         return(p);
  1088. }
  1089. _popstate(l,p) int (*l[])(),p;
  1090. {
  1091.     if((status&XMODE) == M_FIXUP) return(p); /* want to stay in this mode */
  1092.         sstktop--;
  1093.         stackp = sstk[sstktop].stkp;
  1094.         status = sstk[sstktop].stat&XMODE;
  1095.         return(p);
  1096. }
  1097.  
  1098.  
  1099. /* stack maintanence routines.
  1100.  */
  1101.  
  1102.  
  1103. /* M_COMPILE:
  1104.  *    x spop x    --to--    x,_spop,x
  1105.  * M_EXECUTE:
  1106.  *    stack: string,x   --to--   x
  1107.  *    other: frees storage used by string (if any).
  1108.  */
  1109. _spop(l,p) int(*l[])(),p;
  1110. {
  1111.     union value s;
  1112.  
  1113.     if((status&XMODE) == M_EXECUTE) {
  1114.         s=pop();
  1115.         if(s.sval != 0) free(s.sval);
  1116.     }
  1117.     return(p);
  1118. }
  1119.  
  1120. /* M_COMPILE:
  1121.  *    x pop x    --to--    x,_pop,x
  1122.  * M_EXECUTE:
  1123.  *    stack: int,x    --to--   x
  1124.  */
  1125. _pop(l,p) int(*l[])(),p;
  1126. {
  1127.     if((status&XMODE) == M_EXECUTE) pop();
  1128.     return(p);
  1129. }
  1130.  
  1131. _stop(l,p) int(*l[])(),p;
  1132. {
  1133.     if((status&XMODE) == M_EXECUTE) exit(1);
  1134.     return(p);
  1135. }
  1136. _end(l,p) int (*l[])(),p; { return(_stop(l,p)); }
  1137.  
  1138.  
  1139. SHAR_EOF
  1140. if test 12253 -ne "`wc -c < 'newbs/action.c'`"
  1141. then
  1142.     echo shar: error transmitting "'newbs/action.c'" '(should have been 12253 characters)'
  1143. fi
  1144. fi # end of overwriting check
  1145. echo shar: extracting "'newbs/action.c.new'" '(14386 characters)'
  1146. if test -f 'newbs/action.c.new'
  1147. then
  1148.     echo shar: will not over-write existing file "'newbs/action.c.new'"
  1149. else
  1150. sed 's/^X//' << \SHAR_EOF > 'newbs/action.c.new'
  1151. /* action.c -- "action" routines for interpretor.  These are the base-level
  1152.  *    routines, pointed to by the code-list.
  1153.  */
  1154.  
  1155. #include "bsdefs.h"
  1156.  
  1157. int status = 0;
  1158.  
  1159. /* M_COMPILE:
  1160.  *    x print x   --to--   x,_print,x
  1161.  * M_EXECUTE:
  1162.  *    stack: string,x   --to--   x
  1163.  *    output: "string\n"
  1164.  */
  1165. _print(l,p)
  1166. int (*l[])(),p;
  1167. {
  1168.     union value s1;
  1169.     switch(status&XMODE) {
  1170.     case M_EXECUTE:
  1171.         s1 = pop();
  1172.         printf("%s",s1.sval);
  1173.         if(s1.sval != 0) free(s1.sval);
  1174.     case M_FIXUP:
  1175.     case M_COMPILE: return(p);
  1176.     default:
  1177.         STerror("print");
  1178.     }
  1179. }
  1180.  
  1181. /* M_COMPILE:
  1182.  *    x rlabel name goto x     --to--    x,rlabel,lval,_goto,0,x
  1183.  *    (the 0 is for the benefit of interp())
  1184.  * M_FIXUP: nothing.
  1185.  * any other mode:
  1186.  *    stack: lval,x    --to--    x
  1187.  *    other: Thisline = lval.lval.codelist;
  1188.  *           Thisp = lval.lval.place;
  1189.  */
  1190. _goto(l,p) int (*l[])(),p;
  1191. {
  1192.     union value lval;
  1193.  
  1194.     switch(status&XMODE) {
  1195. #ifdef INT
  1196.     case M_COMPILE: l[p] = 0;
  1197. #endif
  1198.     case M_FIXUP: return(++p);
  1199.     default:
  1200.         lval = pop();
  1201.         if(lval.lval.codelist == 0) ULerror(l,p);
  1202.         Thisline = lval.lval.codelist;
  1203.         Thisline--;
  1204.         Thisp = lval.lval.place;
  1205. if(dbg) printf("_goto:EXEC:to:llent:%o:pl:%d:num:%u\n",lval.lval.codelist,
  1206.     lval.lval.place,lval.lval.codelist->num);
  1207.         return(p);
  1208.     }
  1209. }
  1210.  
  1211. /* M_COMPILE:
  1212.  *    x dlabel name x    --to--    x,_dlabel,&vlist entry,x
  1213.  * M_FIXUP:
  1214.  *    Make vlist entry for "name" point to current place.
  1215.  */
  1216. _dlabel(l,p) int (*l[])(),p;
  1217. {
  1218.     struct dictnode *vp;
  1219.     char *s;
  1220.  
  1221.     switch(status&XMODE) {
  1222. #ifdef INT
  1223.     case M_COMPILE:
  1224.         s=gtok();
  1225.         vp=gvadr(s,T_LBL);
  1226.         l[p++] = vp;
  1227.         return(p);
  1228. #endif
  1229.     case M_FIXUP:
  1230.         vp=l[p++];
  1231.         vp->val.lval.codelist = (int **)gllentry(l);
  1232.         vp->val.lval.place = p;
  1233.         return(p);
  1234.     default: return(++p);
  1235.     }
  1236. }
  1237.  
  1238. /* M_COMPILE:
  1239.  *    x rlabel name x    --to--     x,rlabel,&vlist entry,x
  1240.  * any other mode:
  1241.  *    push(vp->val)    (i.e.  pointer to location of label)
  1242.  */
  1243. _rlabel(l,p) int (*l[])(),p;
  1244. {
  1245.     struct dictnode *vp;
  1246.     char *s;
  1247.  
  1248.     switch(status&XMODE) {
  1249. #ifdef INT
  1250.     case M_COMPILE:
  1251.         s=gtok();
  1252.         vp=gvadr(s,T_LBL);
  1253.         l[p++] = vp;
  1254.         return(p);
  1255. #endif
  1256.     case M_FIXUP: return(++p);
  1257.     default:
  1258.         vp = l[p++];
  1259. if(dbg) printf("_rlabel:M_EXECUTE:name:%s:llent:%o:place:%d\n",vp->name,
  1260.     vp->val.lval.codelist,vp->val.lval.place);
  1261.         push(vp->val);
  1262.         return(p);
  1263.     }
  1264. }
  1265.  
  1266. /* M_COMPILE:
  1267.  *    x rlabel name goto x    --to--    x,_rlabel,lval,_gosub,0,x
  1268.  *
  1269.  * M_EXECUTE:
  1270.  *    stack: lval,x   --to--   x
  1271.  *    other: saves current place (on stack) and jumps to lval.
  1272.  */
  1273. _gosub(l,p) int(*l[])(),p;
  1274. {
  1275.     union value here,there;
  1276.     switch(status&XMODE) {
  1277. #ifdef INT
  1278.     case M_COMPILE:
  1279. #endif
  1280.     case M_FIXUP:
  1281.         l[p++] = 0;
  1282.         return(p);
  1283.     case M_EXECUTE:
  1284.         there = pop();
  1285.         here.lval.codelist = gllentry(l);
  1286.         here.lval.place = p+1;
  1287. if(dbg) printf("_gosub:EXEC:here.l:%o:here.pl:%d:there.l:%o:there.pl:%d\n",
  1288.       here.lval.codelist,here.lval.place,there.lval.codelist,there.lval.place);
  1289.         push(here);
  1290.         Thisline = there.lval.codelist;
  1291.         Thisline--;
  1292.         Thisp = there.lval.place;
  1293.         return(p);
  1294.     default: STerror("gosub");
  1295.     }
  1296. }
  1297.  
  1298. _return(l,p) int(*l[])(),p;
  1299. {
  1300.     union value loc;
  1301.     switch(status&XMODE) {
  1302. #ifdef INT
  1303.     case M_COMPILE:
  1304. #endif
  1305.     case M_FIXUP:
  1306.         l[p++] = 0;
  1307.         return(p);
  1308.     case M_EXECUTE:
  1309.         loc = pop();
  1310.         Thisp = loc.lval.place;
  1311.         Thisline = loc.lval.codelist;
  1312.         Thisline--;
  1313.         return(p);
  1314.     default:
  1315.         STerror("return");
  1316.     }
  1317. }
  1318.  
  1319. /* Routines control entering and leaving of loops.
  1320.  *
  1321.  *    enter -- makes a mark that we have entered a loop, and also records
  1322.  *         branch points for "continue" and "leave".
  1323.  *    exitlp -- undoes the mark made by enter.
  1324.  *    contin -- branches to "continue" point.
  1325.  *    leave -- branches to "leave" point.
  1326.  *
  1327.  * The following stack structure is used to record these loop markers.
  1328.  */
  1329.  
  1330. struct loopstack {
  1331.     struct label contlb,leavlb;
  1332. };
  1333.  
  1334. struct loopstack lpstk[20];
  1335. int lpstkp = -1;    /* -1 when stack is empty.
  1336.              * always points to CURRENT loop marker.
  1337.              */
  1338.  
  1339. /* M_COMPILE:
  1340.  *    x rlabel contlb rlabel leavlb enter x
  1341.  *--to--
  1342.  *    x,_rlabel,contlb,_rlabel,_leavlb,_enter,x
  1343.  *
  1344.  * M_EXECUTE:
  1345.  *    loopstack: x    --to--   <contlb,leavlb>,x
  1346.  */
  1347. _enter(l,p) int (*l[])(),p;
  1348. {
  1349.     union value loc;
  1350.  
  1351.     if((status&XMODE) == M_EXECUTE) {
  1352.     lpstkp++;
  1353.     loc = pop();
  1354. if(dbg) printf("_enter:EXEC:lpsp:%d:leav.list:%o:leav.pl:%d",lpstkp,
  1355.     loc.lval.codelist,loc.lval.place);
  1356.     lpstk[lpstkp].leavlb.codelist = loc.lval.codelist;
  1357.     lpstk[lpstkp].leavlb.place = loc.lval.place;
  1358.     loc = pop();
  1359. if(dbg) printf(":cont.list:%o:cont.pl:%d\n",loc.lval.codelist,loc.lval.place);
  1360.     lpstk[lpstkp].contlb.codelist = loc.lval.codelist;
  1361.     lpstk[lpstkp].contlb.place = loc.lval.place;
  1362.     }
  1363.     return(p);
  1364. }
  1365.  
  1366. /* M_EXECUTE:
  1367.  *    loopstack: <contlb,leavlb>,x    --to--   x
  1368.  *    other: ensures that lpstkp doesnt get less that -1;
  1369.  */
  1370. _exitlp(l,p) int (*l[])(),p;
  1371. {
  1372.     if((status&XMODE) == M_EXECUTE)
  1373.     if(lpstkp >= 0)
  1374.         lpstkp--;
  1375.     else
  1376.         lpstkp = -1;
  1377. if(dbg) printf("_exitlp:M_%d:lpstkp:%d\n",status,lpstkp);
  1378.     return(p);
  1379. }
  1380.  
  1381. /* M_COMPILE:
  1382.  *    x leave x   --to--   x,_leave,0,x
  1383.  *    (the 0 is for the benefit of interp())
  1384.  *
  1385.  * M_EXECUTE:
  1386.  *    loopstack: <contlb,leavlb>,x   --to--   <contlb,leavlb>,x
  1387.  *    other: branches to leavlb.  exitlp takes care of cleaning up stack.
  1388.  */
  1389. _leave(l,p) int(*l[])(),p;
  1390. {
  1391.     switch(status&XMODE) {
  1392. #ifdef INT
  1393.     case M_COMPILE:
  1394. #endif
  1395.     case M_FIXUP: l[p++] = 0; return(p);
  1396.     case M_EXECUTE:
  1397.         if(lpstkp == -1) /* not inside a loop, ergo cannot leave a loop */
  1398.         LVerror(l,p);
  1399.         Thisline = lpstk[lpstkp].leavlb.codelist;
  1400.         Thisline--;
  1401.         Thisp = lpstk[lpstkp].leavlb.place;
  1402.         return(p);
  1403.     default: STerror("leave");
  1404.     }
  1405. }
  1406.  
  1407. /* M_COMPILE:
  1408.  *    x contin x    --to--    x,_contin,0,x
  1409.  *
  1410.  * M_EXECUTE:
  1411.  *    loopstack: <contlb,leavlb>,x   --to--   <contlb,leavlb>,x
  1412.  *    other: jumps to contlb.
  1413.  */
  1414. _contin(l,p) int (*l[])(),p;
  1415. {
  1416.     switch(status&XMODE) {
  1417. #ifdef INT
  1418.     case M_COMPILE:
  1419. #endif
  1420.     case M_FIXUP: l[p++] = 0; return(p);
  1421.     case M_EXECUTE:
  1422.         if(lpstkp == -1) /* cannot continue a loop we're not in */
  1423.         CNerror(l,p);
  1424.         Thisline = lpstk[lpstkp].contlb.codelist;
  1425.         Thisline--;
  1426.         Thisp = lpstk[lpstkp].contlb.place;
  1427.         return(p);
  1428.     default: STerror("contin");
  1429.     }
  1430. }
  1431.  
  1432.  
  1433.  
  1434. /* M_COMPILE:
  1435.  *    x rlabel name if x    --to--   x,_rlabel,vp,if,0,x
  1436.  *    (the 0 is for the benefit for interp()).
  1437.  * M_EXECUTE:
  1438.  *    stack: loc,bool,x     --to--   x
  1439.  *    p: if bool, p=p else p=loc->place
  1440.  */
  1441. _if(l,p)
  1442. int (*l[])(),p;
  1443. {
  1444.     union value bv,lv;
  1445.  
  1446.     switch(status&XMODE) {
  1447.     case M_EXECUTE:
  1448.         lv = pop();
  1449.         bv = pop();
  1450. if(dbg) printf("_if:M_EXECUTE:lv.pl:%d:p:%d:bv.iv:%D\n",lv.lval.place,
  1451.     p,bv.ival);
  1452.         if(bv.ival == (long)0) { /* jump to else part. */
  1453.         Thisline = lv.lval.codelist;
  1454.         Thisline--;
  1455.         Thisp = lv.lval.place;
  1456.         }
  1457.         else p++;    /* skip the 0 so we get to the then part */
  1458.         return(p);
  1459.     case M_FIXUP:
  1460.     case M_COMPILE: l[p++] = 0; return(p);
  1461.     default: STerror("if");
  1462.     }
  1463. }
  1464.  
  1465. /* M_COMPILE:
  1466.  *    var name <from>expr <to>expr <step>expr <flag>con 0 dlabel FORx rlabel FORx+1 for
  1467.  *--to--
  1468.  *    _var,vp,<from>,<to>,<step>,<flag>,0,_dlabel,lblp,_rlabel,lblp2,_for
  1469.  *
  1470.  * M_EXECUTE:
  1471.  *    stack: xitpt,vizd,step,to,from,vp,x
  1472.  *    other: if exit conditions are correct, jump to exit point.
  1473.  *        vizd is used to hold the data type for vp.  Data types
  1474.  *        are always non-zero so the test for the first visit to
  1475.  *        the loop is to see if vizd is 0.
  1476.  */
  1477. _for(l,p) int(*l[])(),p;
  1478. {
  1479.     union value xitpt,vizd,from,to,step,place;
  1480.  
  1481.     switch(status&XMODE) {
  1482. #ifdef INT
  1483.     case M_COMPILE:
  1484. #endif
  1485.     case M_FIXUP: l[p++] = 0; return(p);
  1486.     case M_EXECUTE:
  1487.         xitpt = pop();
  1488.         vizd = pop();
  1489.         step = pop();
  1490.          to = pop();
  1491.         from = pop();
  1492. if(dbg)
  1493. printf("_for:EXEC:xit.l:%o:xit.pl:%d:viz.iv:%D:step.iv:%D:to.iv:%D:from.iv:%D:",
  1494. xitpt.lval.codelist,xitpt.lval.place,(long)vizd.ival,(long)step.ival,
  1495. (long)to.ival,(long)from.ival);
  1496.         if(vizd.ival == 0) { /* first visit to loop */
  1497.         place = pop();
  1498. if(dbg) printf("first time:var:%s:",place.vpval->name);
  1499.         vizd.ival = place.vpval->type_of_value&T_TMASK; /* != 0 */
  1500.         place.plval = getplace(place.vpval);
  1501.         *(place.plval) = from;    /* since first time, set starting val */
  1502. if(dbg) printf("var.pl:%o:var.val:%D:",place.plval,(long)place.plval->ival);
  1503.         if(vizd.ival==T_INT && step.ival==0)
  1504.             if(to.ival < from.ival)
  1505.                 step.ival = -1;
  1506.             else
  1507.                 step.ival = 1;
  1508.         else if(vizd.ival==T_DBL && step.rval==0)
  1509.             if(to.rval < from.rval)
  1510.                 step.rval = -1;
  1511.             else
  1512.                 step.rval = 1;
  1513.         }
  1514.         else 
  1515.         place = pop();
  1516. if(dbg) printf("var.place:%o:",place.plval);
  1517.  
  1518.         /* The stack frame is now correctly popped off.
  1519.          * Next, we check if the loop is finished.
  1520.          */
  1521.  
  1522.         if(vizd.ival == T_INT)
  1523.         if(step.ival<0 && place.plval->ival<to.ival) 
  1524.             goto loop_done;
  1525.         else if(step.ival>0 && place.plval->ival>to.ival) 
  1526.             goto loop_done;
  1527.         else /* vizd.ival == T_DBL */
  1528.         if(step.rval<0 && place.plval->rval<to.rval) 
  1529.             goto loop_done;
  1530.         else if(step.rval>0 && place.plval->rval>to.rval) 
  1531.             goto loop_done;
  1532.  
  1533.         /* Loop is not done yet, push back stack frame. */
  1534.  
  1535. if(dbg) printf("loop not done, push everything back\n");
  1536.         push(place);
  1537.         push(from);
  1538.         push(to);
  1539.         push(step);
  1540.             push(vizd);
  1541.         push(xitpt);
  1542.         return(p);
  1543.  
  1544.     default: STerror("for");
  1545.     }
  1546.  
  1547.  
  1548.      /* Come here when the loop is finished. */
  1549.  
  1550. loop_done:
  1551. if(dbg) printf("loop done, jump to xitpt\n");
  1552.     Thisline = xitpt.lval.codelist;
  1553.     Thisline--;
  1554.     Thisp = xitpt.lval.place;
  1555.     return(p);
  1556. }
  1557.  
  1558. /* M_COMPILE:
  1559.  *    var name next rlabel FORx go@ dlabel FORx+1
  1560.  *--to--
  1561.  *    _var,vp,_next,_rlabel,lblp,_go_at,dlabel,lblp2
  1562.  *
  1563.  * M_EXECUTE:
  1564.  *    stack: same as M_EXECUTE in _for.
  1565.  *    other: adds step to (control var)->val.
  1566.  */
  1567. _next(l,p) int(*l[])(),p;
  1568. {
  1569.     union value vp,xitpt,vizd,step,to,from,place;
  1570.  
  1571.     switch(status&XMODE) {
  1572.     case M_COMPILE:
  1573.     case M_FIXUP: return(p);
  1574.     case M_EXECUTE:
  1575.         vp = pop();
  1576. if(dbg) printf("_next():EXEC:var:%s",vp.vpval->name);
  1577.         vp.plval = getplace(vp.vpval);
  1578. if(dbg) printf(":vp.pl:%o:",vp.plval);
  1579.         xitpt = pop();
  1580.         vizd = pop();
  1581.         step = pop();
  1582.         to = pop();
  1583.         from = pop();
  1584.         place = pop();
  1585. if(dbg) printf("pl.pl:%o:from.iv:%D:to.iv:%D:step.iv:%D:viz.iv:%D:",
  1586. place.plval,(long)from.ival,(long)to.ival,(long)step.ival,(long)vizd.ival);
  1587. if(dbg) printf("xit.list:%o:xit.pl:%d:xit.num:%u\n",xitpt.lval.codelist,
  1588. xitpt.lval.place,xitpt.lval.codelist->num);
  1589.         if(place.plval != vp.plval) 
  1590.         FNerror(l,p);
  1591.         if(vizd.ival == T_INT)
  1592.         place.plval->ival += step.ival;
  1593.         else
  1594.         place.plval->rval += step.rval;
  1595.         push(place);
  1596.         push(from);
  1597.         push(to);    
  1598.         push(step);
  1599.         push(vizd);    
  1600.         push(xitpt);
  1601.         return(p);
  1602.     default: STerror("next");
  1603.     }
  1604. }
  1605.  
  1606. /* variables needed for M_READ. */
  1607.  
  1608. struct line *dlist[DLSIZ];
  1609. int dlp = 0;
  1610. int dlindx = 2;        /* skips <_data,0> */
  1611. int dtype;        /* type of last operation. */
  1612.  
  1613.  
  1614. /* M_COMPILE:
  1615.  *    x data x     --to--    x,_data,0,x     (0 is for interp())
  1616.  * M_FIXUP:
  1617.  *    allocates a spot in dlist, stores pointer to llist entry for
  1618.  *    this line at that spot.
  1619.  * M_EXECUTE:
  1620.  *    Returns, with p pointing at the zero, making interp() return.
  1621.  */
  1622. _data(l,p) int(*l[])(),p;
  1623. {
  1624.     switch(status&XMODE) {
  1625. #ifdef INT
  1626.     case M_COMPILE:
  1627.         l[p++] = 0;
  1628.         return(p);
  1629. #endif
  1630.     case M_FIXUP:
  1631.         dlist[dlp++] = gllentry(l);
  1632.         p++;
  1633.     case M_EXECUTE: return(p);
  1634.     default:
  1635.         STerror("data");
  1636.     }
  1637. }
  1638.  
  1639. /* M_COMPILE:  x dsep x   --to--   x,_dsep,0,x
  1640.  */
  1641. _dsep(l,p) int(*l[])(),p;
  1642. {
  1643.     switch(status&XMODE) {
  1644. #ifdef INT
  1645.     case M_COMPILE:
  1646. #endif
  1647.     case M_FIXUP:
  1648.         l[p++] = 0;
  1649.     case M_READ:
  1650.     case M_EXECUTE: return(p);
  1651.     default: STerror("dsep");
  1652.     }
  1653. }
  1654.  
  1655. /* routines for changing the interpretors state. */
  1656.  
  1657. struct statstk {    /* for saving old states */
  1658.     int stkp;
  1659.     int stat;
  1660. } sstk[30];
  1661. int sstktop = 0;
  1662.  
  1663. /* M_COMPILE:
  1664.  *    x pushstate <state> x    --to--    x,pushstate,<state>,x
  1665.  * M_FIXUP:
  1666.  *    skip <state>
  1667.  * any other state:
  1668.  *    save old state and stack pointer.
  1669.  *    set state to <state>.
  1670.  */
  1671. _pushstate(l,p) int (*l[])(),p;
  1672. {
  1673.     switch(status&XMODE) {
  1674. #ifdef INT
  1675.     case M_COMPILE:
  1676.         l[p++] = atoi(int_in());
  1677.         return(p);
  1678. #endif
  1679.     case M_FIXUP: return(++p);
  1680.     default:
  1681.         sstk[sstktop].stkp = stackp;
  1682.         sstk[sstktop].stat = status;
  1683.         sstktop++;
  1684.         status = l[p++];
  1685.         return(p);
  1686.     }
  1687. }
  1688. _popstate(l,p) int (*l[])(),p;
  1689. {
  1690.     switch(status&XMODE) {
  1691. #ifdef INT
  1692.     case M_COMPILE:
  1693. #endif
  1694.     case M_FIXUP: return(p);
  1695.     default:
  1696.         sstktop--;
  1697.         stackp = sstk[sstktop].stkp;
  1698.         status = sstk[sstktop].stat&XMODE;
  1699.         return(p);
  1700.     }
  1701. }
  1702.  
  1703.  
  1704. /* stack maintanence routines.
  1705.  */
  1706.  
  1707.  
  1708. /* M_COMPILE:
  1709.  *    x spop x    --to--    x,_spop,x
  1710.  * M_EXECUTE:
  1711.  *    stack: string,x   --to--   x
  1712.  *    other: frees storage used by string (if any).
  1713.  */
  1714. _spop(l,p) int(*l[])(),p;
  1715. {
  1716.     union value s;
  1717.  
  1718.     switch(status&XMODE) {
  1719.     case M_EXECUTE:
  1720.         s=pop();
  1721.         if(s.sval != 0) free(s.sval);
  1722. #ifdef INT
  1723.     case M_COMPILE:
  1724. #endif
  1725.     case M_FIXUP: return(p);
  1726.     default:
  1727.         STerror("spop");
  1728.     }
  1729. }
  1730.  
  1731. /* M_COMPILE:
  1732.  *    x pop x    --to--    x,_pop,x
  1733.  * M_EXECUTE:
  1734.  *    stack: int,x    --to--   x
  1735.  */
  1736. _pop(l,p) int(*l[])(),p;
  1737. {
  1738.     switch(status&XMODE) {
  1739.     case M_FIXUP:
  1740.     case M_COMPILE: return(p);
  1741.     case M_EXECUTE: pop(); return(p);
  1742.     default:
  1743.         STerror("pop");
  1744.     }
  1745. }
  1746.  
  1747. _stop(l,p) int(*l[])(),p;
  1748. {
  1749.     switch(status&XMODE) {
  1750.     case M_FIXUP:
  1751.     case M_COMPILE: return(p);
  1752.     case M_EXECUTE: exit(1);
  1753.     default:
  1754.         STerror("stop");
  1755.     }
  1756. }
  1757. _end(l,p) int (*l[])(),p; { return(_stop(l,p)); }
  1758.  
  1759.  
  1760. /* operator list for the intermediate language. */
  1761. struct wlnode wlist[] = {
  1762.     "itoa",_itoa,    "print",_print,    "goto",_goto,    "if",_if,
  1763.     "rtoa",_rtoa,    "itor",_itor,    "rtoi",_rtoi,
  1764.     "gosub",_gosub, "return",_return,
  1765.     "icon",_icon,    "i+",_iadd,    "-",_isub,
  1766.     "rcon",_rcon,    "r+",_radd,    "r-",_rsub,
  1767.     "r*",_rmult,    "r/",_rdiv,
  1768.     "i*",_imult,    "i/",_idiv,    "i%",_imod,
  1769.     "scon",_scon,    ",",_comma,    ";",_scolon,
  1770.     "i==",_ieq,    "s==",_seq,    "r==",_req,
  1771.     "i<>",_ineq,    "r<>",_rneq,    "s<>",_sneq,
  1772.     "i<=",_ileq,    "s<=",_sleq,    "r<=",_rleq,
  1773.     "i<",_ilt,    "s<",_slt,    "r<",_rlt,
  1774.     "i>=",_igeq,    "s>=",_sgeq,    "r>=",_rgeq,
  1775.     "i>",_igt,    "s>",_sgt,    "r>",_rgt,
  1776.     "or",_or,    "and",_and,    "not",_not,
  1777.     "val",_val,    "var",_var,    "store",_store,
  1778.     "pop",_pop,    "spop",_spop,
  1779.     "pushstate",_pushstate,"popstate",_popstate,
  1780.     "stop",_stop,    "end",_end,
  1781.     "for",_for,    "next",_next,
  1782.     "dlabel",_dlabel,"rlabel",_rlabel,
  1783.     "contin",_contin,"leave",_leave,"enter",_enter,"exitlp",_exitlp,
  1784.     "data",_data,    "dsep",_dsep,
  1785.     0,0
  1786. };
  1787.  
  1788. SHAR_EOF
  1789. if test 14386 -ne "`wc -c < 'newbs/action.c.new'`"
  1790. then
  1791.     echo shar: error transmitting "'newbs/action.c.new'" '(should have been 14386 characters)'
  1792. fi
  1793. fi # end of overwriting check
  1794. echo shar: extracting "'newbs/bsint.c'" '(5406 characters)'
  1795. if test -f 'newbs/bsint.c'
  1796. then
  1797.     echo shar: will not over-write existing file "'newbs/bsint.c'"
  1798. else
  1799. sed 's/^X//' << \SHAR_EOF > 'newbs/bsint.c'
  1800. /* bsint.c -- main part of interpretor.
  1801.  */
  1802.  
  1803. #include "bsdefs.h"
  1804.  
  1805. int (*_null[])() = { 0,0 };
  1806.  
  1807. struct line llist[NUMLINES] = {
  1808.     0, _null, "",
  1809.     MAXLN, _null, ""
  1810. };
  1811.  
  1812. struct line *lastline = &llist[1];
  1813. struct line *Thisline = &llist[0];
  1814. int Thisp = 0;
  1815.  
  1816. struct dictnode vlist[VLSIZ];
  1817.  
  1818.  
  1819.  
  1820. /* gtok() -- read a token using input().  Tokens are delimited by whitespace.
  1821.  *    When '\n' is found, "\n" is returned.
  1822.  *    For EOF or control characters (not '\n' or '\t') 0 is returned.
  1823.  */
  1824. char *gtok()
  1825. {
  1826.     static char token[20];
  1827.     register char *s,c;
  1828.  
  1829.     s = &token[0];
  1830. loop: c=input();
  1831.     if(c==' ' || c=='\t') goto loop;
  1832.     else if(c == '\n') return("\n");
  1833.     else if(c==EOF || iscntrl(c)) return(0);
  1834.     else {
  1835.     *s++ = c;
  1836.     for(c=input(); c>' ' && c<='~'; c=input())
  1837.         *s++ = c;
  1838.     unput(c);
  1839.     *s++ = '\0';
  1840.     return(token);
  1841.     }
  1842. }
  1843.  
  1844. /* insline(num) -- insert num into llist with insertion sort style.
  1845.  *    Replaces old lines if already in list.
  1846.  */
  1847. struct line *insline(num)
  1848. int num;
  1849. {
  1850.     struct line *p,*p2,*p3;
  1851.     struct dictnode *vp;
  1852.     struct dictnode *gvadr();
  1853.     char s[12];
  1854.  
  1855.     if(lastline == LASTLINE) return(0);
  1856.     for(p=lastline; p->num > num; p--)
  1857.     /* null */ ;
  1858.     if(p->num == num) {
  1859.     if(p->code != 0) { free(p->code); p->code = 0; }
  1860.     if(p->text != 0) { free(p->text); p->text = 0; }
  1861.     }
  1862.     else { /* p->num < num */
  1863.     ++p;
  1864.     p2=lastline;
  1865.     p3= ++lastline;
  1866.     while(p2 >= p) {
  1867.         p3->num = p2->num;
  1868.         p3->code = p2->code;
  1869.         p3->text = p2->text;
  1870.         p2--;
  1871.         p3--;
  1872.     }
  1873.     p->num = num;
  1874.     p->text = p->code = 0;
  1875.     }
  1876.     sprintf(s,"LN%d",num);
  1877.     vp = gvadr(s,T_LBL);
  1878.     vp->val.lval.codelist = p;
  1879.     vp->val.lval.place = 0;
  1880.     return(p);
  1881. }
  1882.  
  1883.  
  1884.  
  1885. /* gladr() -- get address of llist entry, given the line number.
  1886.  */
  1887. struct line *gladr(lnum)
  1888. unsigned lnum;
  1889. {
  1890.     register struct line *q;
  1891.     register int num;
  1892.  
  1893.     num = lnum;
  1894.     for(q= &llist[0]; q->num!=num && q->num!=MAXLN ; q++)
  1895.         ;
  1896.     if(q->num == MAXLN) return(0);
  1897.     /* else */
  1898.     if(q->code==0 && q->text==0) return(0); /* fake line */
  1899.     /* else */
  1900.     return(q); /* found place */
  1901. }
  1902.  
  1903. /* gllentry() -- Given an address for a code list, return llist entry which
  1904.  *    has matching code list address.
  1905.  */
  1906. struct line *gllentry(l)
  1907. int **l;
  1908. {
  1909.     register int llp;
  1910.  
  1911.     for(llp=0; llist[llp].num != MAXLN; llp++)
  1912.     if(llist[llp].code == l)
  1913.         return(&llist[llp]);
  1914.  
  1915.     return(0);    /* such an entry not found */
  1916. }
  1917.  
  1918. /* glist() -- read rest of line as a code list, return the corresponding
  1919.  *    code list.
  1920.  */
  1921. int **glist()
  1922. {
  1923.     register char *s;
  1924.     int (*codestring[100])();
  1925.     int lp,(**l)();
  1926.     register int i;
  1927.  
  1928.     lp=0;
  1929.     for(s=gtok(); s!=0 && strcmp(s,"\n")!=0; s=gtok()) {
  1930.     for(i=0; wlist[i].name!=0; i++)
  1931.         if(strcmp(wlist[i].name,s)==0)
  1932.         break;
  1933.     if(wlist[i].name == 0) {
  1934.         fprintf(stderr,"unknown name %s\n",s);
  1935.         exit(1);
  1936.     }
  1937.     if(wlist[i].funct == 0) {
  1938.         fprintf(stderr,"glist: no function for %s at %o\n",s,&wlist[i]);
  1939.         exit(1);
  1940.     }
  1941.     codestring[lp++] = wlist[i].funct;
  1942.     lp = (*wlist[i].funct)(codestring,lp);
  1943.     }
  1944.     codestring[lp++] = 0;
  1945.     l = myalloc(lp*2+1);
  1946.     blcpy(l,codestring,lp*2);
  1947.     return(l);
  1948. }
  1949.  
  1950. /* rprg -- read in a bunch of lines, put them in program buffer.
  1951.  */
  1952. rprg()
  1953. {
  1954.     char *s;
  1955.     int ln;
  1956.     struct line *pl;
  1957.  
  1958.     for(s=gtok(); s!=0; s=gtok()) {
  1959.     if(strcmp(s,"line") == 0) {
  1960.         s=gtok();
  1961.         ln=atoi(s);
  1962.         pl=insline(ln);
  1963.         if(pl == 0) {
  1964.         fprintf(stderr,"out of room for program\n");
  1965.         exit(1);
  1966.         }
  1967.         s=myalloc(strlen(ibuf)+1);
  1968.         strcpy(s,ibuf);
  1969.         pl->text = s;
  1970.         pl->code = glist();
  1971.     }
  1972.     else { 
  1973.         fprintf(stderr,"syntax error, no line number: %s\n",ibuf);
  1974.         exit(1);
  1975.     }
  1976.     }
  1977. }
  1978.  
  1979.  
  1980. interp(l,start)
  1981. int (*l[])(),start;
  1982. {
  1983.     int lp;
  1984.     for(lp=start+1; l[lp-1]!=0; lp++)
  1985.     lp = (*l[lp-1])(l,lp);
  1986.     return(lp);
  1987. }
  1988.  
  1989. /* runit() -- run the program in llist.  arg- address of place to start at.
  1990.  *
  1991.  * to do a goto type action, set Thisline to llist entry PREVIOUS to 
  1992.  * desired place.  Set Thisp to desired index.  To cause it to happen,
  1993.  * place a 0 in the code list where interp() will see it at the right
  1994.  * time.
  1995.  *
  1996.  * All this will cause runit() to run correctly, and automatically take
  1997.  * care of updating the line number pointers (Thisline and Thisp).
  1998.  */
  1999. runit()
  2000. {
  2001.     int ourthisp;
  2002.  
  2003.     ourthisp = Thisp;
  2004.     Thisp = 0;
  2005.     while(Thisline < lastline) {
  2006.     interp((Thisline->code),ourthisp);
  2007.     ++Thisline;
  2008.     ourthisp = Thisp;
  2009.     Thisp = 0;
  2010.     }
  2011. }
  2012.  
  2013. int dbg = 0;    /* debugging flag. */
  2014. main(argc,argv)
  2015. int argc;
  2016. char **argv;
  2017. {
  2018.     int i,j;
  2019.     int (**l)();
  2020.  
  2021.     if(argc >= 2) {
  2022.     if((bsin=fopen(argv[1],"r")) == NULL) {
  2023.         fprintf(stderr,"main: could not open input file %s\n",argv[1]);
  2024.         exit(1);
  2025.     }
  2026.     }
  2027.     if(argc > 2)
  2028.     dbg = 1;    /* "int file <anything>" sets debugging */
  2029.  
  2030.     /* Read the program (on file bsin) and compile it to the executable code. */
  2031.     rdlin(bsin);
  2032.     status = M_COMPILE;
  2033.     rprg();
  2034.     if(bsin != stdin) 
  2035.     fclose(bsin);
  2036.     bsin = stdin;    /* make sure it is stdin for execution */
  2037.     iptr = 0;
  2038.     ibuf[iptr] = 0;    /* make the input buffer empty. */
  2039.  
  2040.     /* Scan through the compiled code, make sure things point to where
  2041.      * they are supposed be pointing to, etc.
  2042.      */
  2043.     status = M_FIXUP;
  2044.     Thisline = &llist[0];
  2045.     while(Thisline < lastline) {
  2046.     interp((Thisline->code),0);
  2047.     ++Thisline;
  2048.     }
  2049.  
  2050.     status = M_EXECUTE;
  2051.     dlp = 0;    /* set it back to beginning of list */
  2052.     Thisline = &llist[0];
  2053.     Thisp = 0;
  2054.     runit();
  2055. }
  2056. SHAR_EOF
  2057. if test 5406 -ne "`wc -c < 'newbs/bsint.c'`"
  2058. then
  2059.     echo shar: error transmitting "'newbs/bsint.c'" '(should have been 5406 characters)'
  2060. fi
  2061. fi # end of overwriting check
  2062. echo shar: extracting "'newbs/errors.c'" '(1583 characters)'
  2063. if test -f 'newbs/errors.c'
  2064. then
  2065.     echo shar: will not over-write existing file "'newbs/errors.c'"
  2066. else
  2067. sed 's/^X//' << \SHAR_EOF > 'newbs/errors.c'
  2068. /* errors.c -- error message routines for int.
  2069.  */
  2070.  
  2071. #include "bsdefs.h"
  2072.  
  2073.  
  2074. /* ULerror() -- unknown line (cannot find wanted line)
  2075.  */
  2076. ULerror(l,p) int(*l[])(),p;
  2077. {
  2078.     fprintf(stderr,"Unknown line %d\n",*(l[p]));
  2079.     exit(1);
  2080. }
  2081.  
  2082. /* STerror() -- wrong value for status variable
  2083.  */
  2084. XSTerror(f) char *f;
  2085. {
  2086.     fprintf(stderr,"%s: illegal status %o\n",f,status);
  2087.     exit(1);
  2088. }
  2089. /* FNerror() -- For Next error
  2090.  */
  2091. XFNerror(l,p)
  2092. int (*l[])(),p;
  2093. {
  2094.     struct dictnode *nv;
  2095.     struct line *ll;
  2096.  
  2097.     ll = gllentry(l);
  2098.     nv = l[p-2];
  2099.     fprintf(stderr,"Next %s, For (something else), at line %u\n",
  2100.     nv->name,ll->num);
  2101.     exit(1);
  2102. }
  2103.  
  2104. ODerror(l,p)
  2105. int (*l[])(),p;
  2106. {
  2107.     struct line *ll;
  2108.     char *s;
  2109.     ll = gllentry(l);
  2110.     s = ((struct dictnode *)l[p])->name;
  2111.     fprintf(stderr,"Out of Data in line %u at var %s\b",ll->num,s);
  2112.     exit(1);
  2113. }
  2114.  
  2115. BDerror(l,p)
  2116. int (*l[])(),p;
  2117. {
  2118.     struct line *ll;
  2119.     char *s;
  2120.     ll = gllentry(l);
  2121.     s = ((struct dictnode *)l[p])->name;
  2122.     fprintf(stderr,"Bad Data type in line %u at var %s\n",ll->num,s);
  2123.     exit(1);
  2124. }
  2125.  
  2126. VTerror(l,p)
  2127. int (*l[])(),p;
  2128. {
  2129.     struct dictnode *vp;
  2130.     vp = (struct dictnode *)l[p];
  2131.     fprintf(stderr,"Invalid data type %d for var %s\n",vp->type_of_value,vp->name);
  2132.     exit(1);
  2133. }
  2134.  
  2135. LVerror(l,p) int(*l[])(),p;
  2136. {
  2137.     struct line *ll;
  2138.     ll = gllentry(l);
  2139.     fprintf(stderr,"Tried to leave while not in a loop, at line %u\n",ll->num);
  2140.     exit(1);
  2141. }
  2142.  
  2143. CNerror(l,p) int(*l[])(),p;
  2144. {
  2145.     struct line *ll;
  2146.     ll = gllentry(l);
  2147.     fprintf(stderr,"Tried to continue while not in a loop, at line %u\n",ll->num);
  2148.     exit(1);
  2149. }
  2150. SHAR_EOF
  2151. if test 1583 -ne "`wc -c < 'newbs/errors.c'`"
  2152. then
  2153.     echo shar: error transmitting "'newbs/errors.c'" '(should have been 1583 characters)'
  2154. fi
  2155. fi # end of overwriting check
  2156. echo shar: extracting "'newbs/mkrbop.c'" '(734 characters)'
  2157. if test -f 'newbs/mkrbop.c'
  2158. then
  2159.     echo shar: will not over-write existing file "'newbs/mkrbop.c'"
  2160. else
  2161. sed 's/^X//' << \SHAR_EOF > 'newbs/mkrbop.c'
  2162. /* mkrbop.c -- make operator functions for bs.  (real-boolean functions.)
  2163. *
  2164. *    USAGE: op name oper
  2165. *
  2166. * where:    name: name of function generated.
  2167. *        oper: operator for operation.
  2168. */
  2169. #include <stdio.h>
  2170.  
  2171. main(argc,argv)
  2172. char **argv;
  2173. int argc;
  2174. {
  2175. char *name,*oper;
  2176.  
  2177. if(argc != 3) {
  2178.     fprintf(stderr,"arg count\n");
  2179.     exit(1);
  2180. }
  2181. name = argv[1]; oper = argv[2];
  2182.  
  2183. printf("_%s(l,p)\n",name);
  2184. printf("int (*l[])(),p;\n");
  2185. printf("{\n");
  2186. printf("    union value rg1,rg2,result;\n");
  2187. printf("\n");
  2188. printf("    if((status&XMODE) == M_EXECUTE) {\n");
  2189. printf("    rg2 = pop();\n");
  2190. printf("    rg1 = pop();\n");
  2191. printf("    result.ival = rg1.rval %s rg2.rval;\n",oper);
  2192. printf("    push(result);\n");
  2193. printf("    }\n");
  2194. printf("    return(p);\n");
  2195. printf("}\n");
  2196. }
  2197. SHAR_EOF
  2198. if test 734 -ne "`wc -c < 'newbs/mkrbop.c'`"
  2199. then
  2200.     echo shar: error transmitting "'newbs/mkrbop.c'" '(should have been 734 characters)'
  2201. fi
  2202. fi # end of overwriting check
  2203. echo shar: extracting "'newbs/operat.c.new'" '(9302 characters)'
  2204. if test -f 'newbs/operat.c.new'
  2205. then
  2206.     echo shar: will not over-write existing file "'newbs/operat.c.new'"
  2207. else
  2208. sed 's/^X//' << \SHAR_EOF > 'newbs/operat.c.new'
  2209. /* operat.c -- operations, as opposed to actions.  FOR is an action,
  2210.  *    '+' is an operation.
  2211.  *
  2212.  * More operators can be found in the machine generated file "operat2.c".
  2213.  */
  2214.  
  2215. #include "bsdefs.h"
  2216.  
  2217.  
  2218. /*    BINARY OPERATORS    */
  2219.  
  2220. /* Common description for the binary ops.
  2221.  *  also applies to all ops in operat2.c
  2222.  *
  2223.  * M_COMPILE:
  2224.  *    x op x   --to--   x,_op,x
  2225.  * M_EXECUTE:
  2226.  *    stack: ar2,ar1,x   --to--   (ar1 op ar2),x
  2227.  */
  2228.  
  2229.  
  2230. _comma(l,p) int (*l[])(),p;
  2231. {
  2232.     union value s1,s2,s3;
  2233.     switch(status&XMODE) {
  2234. #ifdef INT
  2235.     case M_COMPILE:
  2236. #endif
  2237.     case M_FIXUP: return(p);
  2238.     case M_READ: dtype = T_CHR;
  2239.     case M_EXECUTE:
  2240.         s1 = pop();
  2241.         s2 = pop();
  2242.         s3.sval = myalloc(strlen(s1.sval)+strlen(s2.sval)+3);
  2243.         strcpy(s3.sval,s2.sval);
  2244.         strcat(s3.sval,"\t");
  2245.         strcat(s3.sval,s1.sval);
  2246.         if(s1.sval != 0) free(s1.sval);
  2247.         if(s2.sval != 0) free(s2.sval);
  2248.         push(s3);
  2249.         return(p);
  2250.     default: STerror("comma");
  2251.     }
  2252. }
  2253. _scolon(l,p) int(*l[])(),p;
  2254. {
  2255.     union value s1,s2,s3;
  2256.     switch(status&XMODE) {
  2257. #ifdef INT
  2258.     case M_COMPILE:
  2259. #endif
  2260.     case M_FIXUP: return(p);
  2261.     case M_READ: dtype = T_CHR;
  2262.     case M_EXECUTE:
  2263.         s1 = pop();
  2264.         s2 = pop();
  2265.         s3.sval = myalloc(strlen(s1.sval)+strlen(s2.sval)+2);
  2266.         strcpy(s3.sval,s2.sval);
  2267.         strcat(s3.sval,s1.sval);
  2268.         push(s3);
  2269.         if(s1.sval != 0) free(s1.sval);
  2270.         if(s2.sval != 0) free(s2.sval);
  2271.         return(p);
  2272.     default:
  2273.         STerror("scolon");
  2274.     }
  2275. }
  2276. /* last of binary operators */
  2277.  
  2278. /* M_COMPILE:
  2279.  *    x not x    --to--    x,_not,x
  2280.  * M_EXECUTE:
  2281.  *    stack: bool,x    --to--     !(bool),x
  2282.  */
  2283. _not(l,p) int (*l[])(),p;
  2284. {
  2285.     union value val;
  2286.  
  2287.     if((status&XMODE) == M_EXECUTE) {
  2288.     val = pop();
  2289.     val.ival = ! val.ival;
  2290.     push(val);
  2291.     }
  2292.     return(p);
  2293. }
  2294.  
  2295. /* M_COMPILE:
  2296.  *    x itoa x   --to--   x,_itoa,x
  2297.  * M_EXECUTE:
  2298.  *    stack: int,x   --to--   string,x
  2299.  */
  2300. _itoa(l,p)
  2301. int (*l[])(),p;
  2302. {
  2303.     union value val;
  2304.     char s2[30];
  2305.  
  2306.     switch(status&XMODE) {
  2307.     case M_FIXUP:
  2308.     case M_COMPILE: return(p);
  2309.     case M_READ:
  2310.         dtype = T_CHR;
  2311.     case M_EXECUTE:
  2312.         val=pop();
  2313.         sprintf(s2,"%D",val.ival);    /* optimize later */
  2314. if(dbg) printf("_icon():M_EXECUTE:ival:%D to sval:%s\n",val.ival,s2);
  2315.         val.sval=myalloc(strlen(s2)+1);
  2316.         strcpy(val.sval,s2);
  2317.         push(val);
  2318.         return(p);
  2319.     default:
  2320.         STerror("itoa");
  2321.     }
  2322. }
  2323. _rtoa(l,p)
  2324. int (*l[])(),p;
  2325. {
  2326.     union value val;
  2327.     char s2[30];
  2328.  
  2329.     switch(status&XMODE) {
  2330.     case M_FIXUP:
  2331.     case M_COMPILE: return(p);
  2332.     case M_READ: dtype = T_CHR;
  2333.     case M_EXECUTE:
  2334.         val = pop();
  2335.         sprintf(s2,"%g",val.rval);
  2336. if(dbg) printf("_rtoa():M_EXECUTE:rval:%g to sval:%s\n",val.rval,s2);
  2337.         val.sval = myalloc(strlen(s2)+1);
  2338.         strcpy(val.sval,s2);
  2339.         push(val);
  2340.         return(p);
  2341.     default: STerror("rtoa");
  2342.     }
  2343. }
  2344. _itor(l,p)
  2345. int (*l[])(),p;
  2346. {
  2347.     union value v1,v2;
  2348.  
  2349.     switch(status&XMODE) {
  2350.     case M_READ: dtype = T_DBL;
  2351.     case M_EXECUTE:
  2352.         v1 = pop();
  2353.         v2.rval = (double)v1.ival;
  2354.         push(v2);
  2355.     case M_FIXUP:
  2356.     case M_COMPILE: return(p);
  2357.     default: STerror("itor");
  2358.     }
  2359. }
  2360. _rtoi(l,p)
  2361. int (*l[])(),p;
  2362. {
  2363.     union value v1,v2;
  2364.  
  2365.     switch(status&XMODE) {
  2366.     case M_READ: dtype = T_INT;
  2367.     case M_EXECUTE:
  2368.         v1 = pop();
  2369.         v2.ival = (int)v1.rval;
  2370.         push(v2);
  2371.     case M_FIXUP:
  2372.     case M_COMPILE: return(p);
  2373.     default: STerror("rtoi");
  2374.     }
  2375. }
  2376.  
  2377. /* M_COMPILE:
  2378.  *    x scon "quoted string" x   --to--   x,_scon,*string,x
  2379.  * M_EXECUTE:
  2380.  *    stack: x   --to--   string,x
  2381.  *    other: pushes a COPY of the string, not the original.
  2382.  */
  2383. _scon(l,p)
  2384. int (*l[])(),p;
  2385. {
  2386.     char *s,c;
  2387.     union value val;
  2388.     int i;
  2389.  
  2390.     switch(status&XMODE) {
  2391. #ifdef INT
  2392.     case M_COMPILE:
  2393.         l[p++] = scon_in();
  2394.         return(p);
  2395. #endif
  2396.     case M_READ:
  2397.         dtype = T_CHR;
  2398.     case M_EXECUTE:
  2399.         s = l[p++];
  2400.         val.sval = myalloc(strlen(s)+1);
  2401.         strcpy(val.sval,s);
  2402.         push(val);
  2403. if(dbg) printf("_scon():M_EXECUTE:sval:%s\n",val.sval);
  2404.         return(p);
  2405.     case M_FIXUP: p++; return(p);
  2406.     default: STerror("scon");
  2407.     }
  2408. }
  2409.  
  2410. /* M_COMPILE:
  2411.  *    x icon int x   --to--   x,_icon,int,x
  2412.  * M_EXECUTE:
  2413.  *    stack: x   --to--   int,x
  2414.  */
  2415. _icon(l,p)
  2416. int (*l[])(),p;
  2417. {
  2418.     union value val;
  2419.     union loni v;
  2420.     int i;
  2421.  
  2422.     switch(status&XMODE) {
  2423. #ifdef INT
  2424.     case M_COMPILE:
  2425.         v.l_in_loni = atol(int_in());
  2426.         for(i=0; i<(sizeof(long)/sizeof(int)); i++)
  2427.         l[p++] = v.i_in_loni[i];
  2428.         return(p);
  2429. #endif
  2430.     case M_READ: dtype = T_INT;
  2431.     case M_EXECUTE:
  2432.         for(i=0; i<(sizeof(long)/sizeof(int)); i++)
  2433.         v.i_in_loni[i] = l[p++];
  2434.         val.ival = v.l_in_loni;
  2435.         push(val);
  2436. if(dbg) printf("_icon():M_EXECUTE:ival:%D\n",val.ival);
  2437.         return(p);
  2438.     case M_FIXUP:
  2439.         p += (sizeof(long)/sizeof(int));
  2440.         return(p);
  2441.     default: STerror("icon");
  2442.     }
  2443. }
  2444. _rcon(l,p)
  2445. int (*l[])(),p;
  2446. {
  2447.     union doni v;
  2448.     int i;
  2449.     union value val;
  2450.  
  2451.     switch(status&XMODE) {
  2452. #ifdef INT
  2453.     case M_COMPILE:
  2454.         v.d_in_doni = atof(real_in());
  2455.         for(i=0; i<(sizeof(double)/sizeof(int)); i++)
  2456.         l[p++] = v.i_in_doni[i];
  2457.         return(p);
  2458. #endif
  2459.     case M_FIXUP:
  2460.         p += (sizeof(double)/sizeof(int));
  2461.         return(p);
  2462.     case M_READ: dtype = T_DBL;
  2463.     case M_EXECUTE:
  2464.         for(i=0; i<(sizeof(double)/sizeof(int)); i++)
  2465.         v.i_in_doni[i] = l[p++];
  2466.         val.rval = v.d_in_doni;
  2467.         push(val);
  2468.         return(p);
  2469.     default: STerror("rcon");
  2470.     }
  2471. }
  2472.  
  2473. /* M_COMPILE:
  2474.  *    x val type x   --to--   x,_val,type,x
  2475.  * M_EXECUTE:
  2476.  *    stack:    place,x   --to--   value,x
  2477.  *    other: for strings, pushes a copy of the string.
  2478.  */
  2479. _val(l,p) int(*l[])(),p;
  2480. {
  2481.     union value place,val;
  2482.     int ty;
  2483.  
  2484.     switch(status&XMODE) {
  2485. #ifdef INT
  2486.     case M_COMPILE:
  2487.         l[p++] = atoi(int_in());
  2488.         return(p);
  2489. #endif
  2490.     case M_READ:
  2491.         dtype = l[p];
  2492.     case M_EXECUTE:
  2493.         ty = l[p];
  2494.         place = pop();
  2495. if(dbg) printf("_val():M_EXECUTE:var:%s",place.vpval->name);
  2496.         place.plval = getplace(place.vpval);
  2497.         if(ty==T_CHR && place.plval->sval!=0) {
  2498.         val.sval = myalloc(strlen(place.plval->sval)+1);
  2499.         strcpy(val.sval,place.plval->sval);
  2500.         push(val);
  2501.         }
  2502.         else push(*place.plval);
  2503. if(dbg) printf(":ival:%D:rval:%g:sval:%s\n",ty==T_INT?place.plval->ival:(long)0,
  2504.     ty==T_DBL?place.plval->rval:(double)0,ty==T_CHR?place.plval->sval:0);
  2505.     case M_FIXUP: p++; return(p);
  2506.     default: STerror("val");
  2507.     }
  2508. }
  2509.  
  2510. /* M_COMPILE:
  2511.  *    x store typ x   --to--    x,_store,type,x
  2512.  * M_EXECUTE:
  2513.  *    stack: value,location,x   --to--   value,x
  2514.  *        (stores value at location).
  2515.  */
  2516. _store(l,p) int(*l[])(),p;
  2517. {
  2518.     union value place,val;
  2519.     int ty;
  2520.  
  2521.     switch(status&XMODE) {
  2522. #ifdef INT
  2523.     case M_COMPILE:
  2524.         l[p++] = atoi(int_in());
  2525.         return(p);
  2526. #endif
  2527.     case M_READ:
  2528.         dtype = l[p];
  2529.     case M_EXECUTE:
  2530.         val = pop();
  2531.         place = pop();
  2532.         ty = l[p];
  2533. if(dbg) printf("_store():M_EXECUTE:var:%s:ival:%D:rval:%g:sval:%s\n",
  2534.     place.vpval->name,ty==T_INT?val.ival:(long)0,ty==T_DBL?val.rval:(double)0,ty==T_CHR?val.sval:0);
  2535.         place.plval = getplace(place.vpval);
  2536.         if(ty==T_CHR && place.plval->sval!=0) free(place.plval->sval);
  2537.         (*place.plval) = val;
  2538.         push(val);
  2539.     case M_FIXUP:
  2540.         p++;
  2541.         return(p);
  2542.     default: STerror("store");
  2543.     }
  2544. }
  2545.  
  2546. /* M_COMPILE:
  2547.  *    x var typ name x   --to--    x,_var,&vlist entry,x
  2548.  * M_EXECUTE:
  2549.  *    stack: x   --to--   &vlist entry,x
  2550.  * M_INPUT:
  2551.  *    (&vlist entry)->val is set to input value.
  2552.  * M_READ:
  2553.  *    Moves the data list pointers to the next data item.  If no next
  2554.  *    data item, calls ODerror.
  2555.  *    Does a "gosub" to the data item, to get its value on the stack.
  2556.  *    Does T_INT to T_CHR conversion if necessary.
  2557.  *    Pops value into vp->val.
  2558.  */
  2559. _var(l,p) int(*l[])(),p; /* same proc for any variable type */
  2560. {
  2561.     char *s;
  2562.     struct dictnode *vp;
  2563.     struct line *thislist;
  2564.     union value place,val;
  2565.     int ty,qual;
  2566.  
  2567.     switch(status&XMODE) {
  2568. #ifdef INT
  2569.     case M_COMPILE:
  2570.         ty = atoi(int_in());
  2571.         s = gtok();
  2572.         l[p++] = gvadr(s,ty);
  2573.         return(p);
  2574. #endif
  2575.     case M_EXECUTE:
  2576.         val.vpval = l[p++];
  2577. if(dbg) printf("_var():M_EXECUTE:var:(%d)%s\n",val.vpval->type_of_value,
  2578.     val.vpval->name);
  2579.         push(val);
  2580.         return(p);
  2581.     case M_INPUT:
  2582.         vp = l[p++];
  2583.         place.plval = getplace(vp);
  2584.         ty = (vp->type_of_value) & T_TMASK;
  2585.         if(ty == T_INT)
  2586.         place.plval->ival = atol(int_in());
  2587.         else if(ty == T_DBL)
  2588.         place.plval->rval = atof(real_in());
  2589.         else 
  2590.         place.plval->sval = scon_in();
  2591. if(dbg) printf("_var():M_INPUT:var:(%d)%s:ival:%D:rval:%g:sval:%s\n",
  2592. vp->type_of_value,vp->name,ty==T_INT?place.plval->ival:(long)0,
  2593. ty==T_DBL?place.plval->rval:(double)0,ty==T_CHR?place.plval->sval:0);
  2594.         return(p);
  2595.     case M_READ:
  2596. nxdl:        if(dlist[dlp] == 0) ODerror(l,p);    /* ran off end of dlist */
  2597.         thislist = dlist[dlp];
  2598.         if((thislist->code)[dlindx] == 0) {
  2599.         dlp++;
  2600.         dlindx = 2;    /* skips <_data,0> */
  2601.         goto nxdl;
  2602.         }
  2603.  
  2604.         status = M_EXECUTE;
  2605.         dlindx = interp(thislist->code,dlindx);
  2606.         status = M_READ;
  2607.  
  2608.         val = pop();
  2609.         vp = l[p];
  2610.         place.plval = getplace(vp);
  2611.         qual = vp->type_of_value&T_TMASK;
  2612.         if(qual == T_INT)
  2613.         place.plval->ival = val.ival;
  2614.         else if(qual == T_DBL)
  2615.         place.plval->rval = val.rval;
  2616.         else if(qual == T_CHR) {
  2617.         if(dtype == T_INT) {
  2618.             push(val); _itoa(l,p); val = pop();
  2619.         }
  2620.         else if(dtype == T_DBL) {
  2621.             push(val); _rtoa(l,p); val = pop();
  2622.         }
  2623.         if(place.plval->sval != 0) free(place.plval->sval);
  2624.         place.plval->sval = myalloc(strlen(val.sval)+1);
  2625.         strcpy(place.plval->sval,val.sval);
  2626.         }
  2627.         else VTerror(l,p);
  2628.     case M_FIXUP:
  2629.         p++;
  2630.         return(p);
  2631.     default: STerror("var");
  2632.     }
  2633. }
  2634. SHAR_EOF
  2635. if test 9302 -ne "`wc -c < 'newbs/operat.c.new'`"
  2636. then
  2637.     echo shar: error transmitting "'newbs/operat.c.new'" '(should have been 9302 characters)'
  2638. fi
  2639. fi # end of overwriting check
  2640. #    End of shell archive
  2641. exit 0
  2642.